DateExtension - GetEasterSunday()

[va!n]

Maybe this small piece of code may help someone?

Code: Select all

; --------------------------------------------------------------
; Function:     GetEasterSunday (lYear)   
;
; lYear......:  Should work with 1900-2048
; 
; Description:  This function returns in "dd.mm.yyyy" format
;               the date of easter sunday!

;
; ReturnValue:  String of the date in "dd.mm.yyyy" format!
;
; Author.....:  Mr.Vain of Secretly! aka Thorsten Will
; Version....:  v1.0 (04-August-2005)
; --------------------------------------------------------------

Procedure.s GetEasterSunday (lYear)
  c 	= 	lYear / 100
  N 	= 	lYear - 19 * (lYear / 19)
  K 	= 	((c - 17) / 25)
  I1 	= 	c - (c >> 2) - ((c - K) / 3) + 19 * N + 15
  I2 	= 	I1 - 30 * (I1 / 30)
  I3 	= 	I2 - (I2 / 28) * (1 - (I2 / 28) * (29 / (I2 + 1)) * ((21 - N) / 11))
  A1 	= 	lYear + (lYear >> 2) + I3 + 2 - c + (c >> 2)
  A2 	= 	A1 - 7 * (A1 / 7)
  l 	= 	I3 - A2
  lMonth	=	3 + ((l + 40) / 44)
  lDay   	= 	l + 28 - 31 * (lMonth >> 2)
  ;  
  cResult$ = Str(lDay)+"."+Str(lMonth)+"."+Str(lYear)
  ProcedureReturn cResult$
EndProcedure 

; ---- Example -------------------------------------------------

res$ = GetEasterSunday(2005)
MessageRequester("EasterSunday", res$, 0)
End

[fsw]

; Author.....: Mr.Vain of Secretly! aka Thorsten Will

I thought it might be you

[va!n]

I thought it might be you

[fweil]

I am really sorry, but some years do not render the same rest using this procedure !

Don't know which is rigth.

Code: Select all

Procedure.s GetEasterSundayEx(Year) ; GetEasterSundayEx(Year) : returns the date in dd.mm.yyyy string format of easter sunday
  a = Year % 19
  b = Year / 100
  c = Year % 100
  d = b / 4
  e = b % 4
  f = (b + 8) / 25
  g = (b - f + 1) / 3
  h = (19 * a + b - d - g + 15) % 30
  i = c / 4
  k = c % 4
  l = (32 + 2 * e + 2 * i - h - k) % 7
  m = (a + 11 * h + 22 * l) / 451
  n = (h + l - 7 * m + 114) / 31
  p = (h + l - 7 * m + 114) % 31
  ProcedureReturn Str(p + 1) + "." + Str(n) + "." + Str(Year)
EndProcedure

I also have this for calendar functions :

Code: Select all

Procedure DayOfWeekEx(Year.l, Month.l, Day.l) ; DayOfWeekEx(Year.l, Month.l, Day.l) : returns the day of week (Monday = 0, ..., Sunday = 6) for years after 1582
  If Month < 3
      Month + 12
      Year - 1
  EndIf
  s = Year / 100
  JD = 1720996.5 - s + Int(s / 4) + (365.25 * Year) + (30.6001 * (Month + 1)) + Day
  JD = JD - (JD / 7) * 7
  ProcedureReturn JD % 7
EndProcedure

and

Code: Select all

Procedure LeapYear(Year) ; LeapYear(Year) : returns #TRUE if Year is a leap year, #FALSE otherwise
  If ((Year % 4 = 0) And (Year % 100 <> 0)) Or (Year % 400 = 0)
      ProcedureReturn #TRUE
    Else
      ProcedureReturn #FALSE
  EndIf
EndProcedure

not really clever but maybe useful.

Rgrds

[va!n]

I am really sorry, but some years do not render the same rest using this procedure ! Don't know which is rigth.

hi fweil! i have tested both procedures with following example (i dont really know what is the max year, that would work correctly but i know the results should be ok from the year 1900... here is my test source...

Code: Select all

Procedure.s GetEasterSundayEx(Year) ; GetEasterSundayEx(Year) : returns the date in dd.mm.yyyy string format of easter sunday
  a = Year % 19
  b = Year / 100
  c = Year % 100
  d = b / 4
  e = b % 4
  f = (b + 8) / 25
  g = (b - f + 1) / 3
  h = (19 * a + b - d - g + 15) % 30
  i = c / 4
  k = c % 4
  l = (32 + 2 * e + 2 * i - h - k) % 7
  m = (a + 11 * h + 22 * l) / 451
  n = (h + l - 7 * m + 114) / 31
  p = (h + l - 7 * m + 114) % 31
  ProcedureReturn Str(p + 1) + "." + Str(n) + "." + Str(Year)
EndProcedure 


Procedure.s GetEasterSunday (lYear)
  c    =    lYear / 100
  n    =    lYear - 19 * (lYear / 19)
  k    =    ((c - 17) / 25)
  I1    =    c - (c >> 2) - ((c - k) / 3) + 19 * n + 15
  I2    =    I1 - 30 * (I1 / 30)
  I3    =    I2 - (I2 / 28) * (1 - (I2 / 28) * (29 / (I2 + 1)) * ((21 - n) / 11))
  A1    =    lYear + (lYear >> 2) + I3 + 2 - c + (c >> 2)
  A2    =    A1 - 7 * (A1 / 7)
  l    =    I3 - A2
  lMonth   =   3 + ((l + 40) / 44)
  lDay      =    l + 28 - 31 * (lMonth >> 2)
  ; 
  cResult$ = Str(lDay)+"."+Str(lMonth)+"."+Str(lYear)
  ProcedureReturn cResult$
EndProcedure 


For lYear = 1900 To 2048
  a$ = GetEasterSunday(lYear)
  b$ = GetEasterSundayEx(lYear)
  ;
  If a$ <> b$
    Debug lYear
    Debug a$
    Debug b$
  EndIf
Next

As you may see there are differents at following points..

Code: Select all

1954
25.4.1954
18.4.1954
1981
26.4.1981
19.4.1981

so i tried to use google and search for the correct dates... i found following site... http://www.adalbert-riehl.de/kalender/feiertag19.htm

seems easterday in 1954 was the 18. April! Mhhh strange, seems my routine has somewhere a bug!? (i cant find it atm)

[horst]

Here is another algorithm (don't remember where I found this). It produces the binary PB date, and thus it works only from 1970.

Code: Select all

DataSection
Passah: ; day offset based 21.Mar = 0
Data.b  24, 13, 2, 21, 10, 28, 18, 7, 26, 15, 4, 23, 12, 1, 20, 9, 27, 17, 6
EndDataSection
#dsec = 60*60*24

Procedure Easter(year_)  ; returns PB date format 
  dif = PeekB(?Passah + (year_ % 19))
  DateSec = ParseDate("%dd.%mm.%yyyy","21.03." + Str(year_)) + dif * #dsec
  DateSec = AddDate(DateSec,#PB_Date_Day, 7 - DayOfWeek(DateSec))
ProcedureReturn DateSec
EndProcedure 

[ts-soft]

Here another one for LeapYear, PB4 ++

Code: Select all

Macro IsLeapYear(Year)
  Not Year % 4 And  (Year % 100 Or Not Year % 400)
EndMacro