Contents Guide Contents

Home Page DigitalDan Home Page

---

This section provides a set of functions for calculating festival dates (Easter, Solstice etc.) for any year. The formulae are designed for readers in the UK and may need adjusting in other countries.
 
Some of these functions are fairly complex. If you are only intereted in a few specific years, it may ve easier to use a look-up table based on an open-source festival date listing.
 
Public Shared Function Easter_Date(ByVal yyyy As Integer) As Date
' This calculation is sometimes called the Computus
Dim a, b, c, d, e, f, g, h, i, k, l, m, mm, dd As Integer
a = yyyy Mod 19
b = yyyy \ 100
c = yyyy Mod 100
d = b \ 4
e = b Mod 4
f = (b + 8) \ 25
g = (b - f + 1) \ 3
h = (19 * a + b - d - g + 15) Mod 30
i = c \ 4
k = c Mod 4
l = (32 + 2 * e + 2 * i - h - k) Mod 7
m = (a + 11 * h + 22 * l) \ 451
mm = (h + l - 7 * m + 114) \ 31
dd = ((h + l - 7 * m + 114) Mod 31) + 1
Return New Date(yyyy, mm, dd, 12, 0, 0)
' returned value is Western Easter date valid for all years after 1600
End Function

 
Public Shared Function Orthodox_Easter_Date(ByVal yyyy As Integer) As Date
Dim r1, r2, r3, r4, r5, ra, rb, rc As Integer
Dim Jul2Greg As Integer
r1 = yyyy Mod 19
r2 = yyyy Mod 4
r3 = yyyy Mod 7
ra = 19 * r1 + 16
r4 = ra Mod 30
rb = 2 * r2 + 4 * r3 + 6 * r4
r5 = rb Mod 7
rc = r4 + r5
Dim eDate As New Date(yyyy, 3, 21)
eDate = DateAdd(DateInterval.Day, rc, eDate)
Jul2Greg = CInt((Int(yyyy \ 100) * 3) / 4) - 2
eDate = DateAdd(DateInterval.Day, Jul2Greg, eDate)
Return eDate
End Function

 
Public Shared Function RoshHashhanah(ByVal yyyy As Integer) As Date
Dim golden As Integer = (yyyy Mod 19) + 1
Dim golden12 As Integer = golden * 12
Dim mm, dd As Integer
Dim rosh As Date
Dim wd As System.DayOfWeek
Dim a As Double, frac As Double
a = (Math.Floor(yyyy / 100) - Math.Floor(yyyy / 400) - 2) + (765433 / 492480 * (golden12 Mod 19)) + ((yyyy Mod 4) / 4) - (((313 * yyyy) + 89081) / 98496)
mm = 9
dd = CInt(Math.Floor(a))
If dd > 30 Then
dd -= 30
mm += 1
End If
rosh = New Date(yyyy, mm, dd)
wd = rosh.DayOfWeek
' Postponement rule 1 - add 1 day if Sunday, Wednesday or Friday
If ((wd = DayOfWeek.Sunday) Or (wd = DayOfWeek.Wednesday) Or (wd = DayOfWeek.Friday)) Then
rosh = rosh.AddDays(1)
End If
' Postponement rule 2 - add 1 day if Monday and fraction>?/? and 12G%19>11
If (wd = DayOfWeek.Monday) Then
frac = a - Math.Floor(a)
If (frac > (23269 / 25920)) Then
If (golden12 Mod 19) > 11 Then
rosh = rosh.AddDays(1)
End If
End If
End If
' Postponement rule 3 - add 2 days if Tuesday and frac>?/? and 12G%19>6
If wd = DayOfWeek.Tuesday Then
frac = a - Math.Floor(a)
If (frac > (1367 / 2160)) Then
If ((golden12 Mod 19) > 6) Then
rosh = rosh.AddDays(2)
End If
End If
End If
Return rosh
End Function

 
Private Shared Function AutumnEquinox(yyyy As Integer) As Date
' function error margin about 40 minutes
Dim basedate As Date
Dim offset As Double
offset = 365.24218967
yyyy -= 2010
'offset = 365.2425 * yyyy
offset *= yyyy
basedate = New Date(2010, 9, 23, 3, 9, 0)
basedate = basedate.AddDays(offset)
Return basedate

 
Private Shared Function SpringEquinox(yyyy As Integer) As Date
' function error margin about 40 minutes
Dim basedate As Date
Dim offset As Double = 365.24218967
yyyy -= 2010
'offset = 365.2425 * yyyy
offset *= yyyy
basedate = New Date(2010, 3, 20, 17, 32, 0)
basedate = basedate.AddDays(offset)
Return basedate
End Function
 
Private Shared Function SummerSolstice(yyyy As Integer) As Date
' function error margin about 40 minutes
Dim basedate As Date
Dim offset As Double
offset = 365.24218967
yyyy -= 2010
'offset = 365.2425 * yyyy
offset *= yyyy
basedate = New Date(2010, 6, 21, 11, 28, 0)
basedate = basedate.AddDays(offset)
Return (basedate)
End Function
 
Private Shared Function WinterSolstice(yyyy As Integer) As Date
' function error margin about 40 minutes
Dim basedate As Date
Dim offset As Double
offset = 365.24218967
yyyy -= 2010
'offset = 365.2425 * yyyy
offset *= yyyy
basedate = New Date(2010, 12, 21, 23, 38, 0)
basedate = basedate.AddDays(offset)
Return basedate
End Function
 
Some Scotland and Northern Ireland Bank Holidays are different ' Thus fubction requires the Easter_Date function (first function in this set of functions)
' and the First_Monday function (provided immediately after this function.)
' The Structures DateName and WeekOfMonth are provided after the First_Monday function.
' This uses official formulaqe but Government sometimes changes dates for May-Day or Spring ' bank holidays, consider using a lookup table for government date changes. Private Shared Function Get_Bank_Holidays_England(yyyy As Integer) As List(Of DateName)
Dim ret As New List(Of DateName) : ret.Clear()
Dim dn As DateName
Dim tDat As Date
dn.Dat = New Date(yyyy, 1, 1, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 1, 3, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 1, 2, 12, 0, 0)
dn.name = "New Years Day"
ret.Add(dn)
tDat = First_Monday(WeekOfMonth.First, DayOfWeek.Monday, yyyy, 3)
dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "May Day"
ret.Add(dn)
tDat = First_Monday(WeekOfMonth.Last, DayOfWeek.Monday, yyyy, 3)
dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "Spring"
ret.Add(dn)
tDat = Easter_Date(yyyy)
dn.Dat = tDat.AddDays(-2) : dn.name = "Good Friday"
ret.Add(dn)
tDat = Easter_Date(yyyy)
dn.Dat = tDat.AddDays(1) : dn.name = "Easter Monday"
ret.Add(dn)
tDat = First_Monday(WeekOfMonth.Last, DayOfWeek.Monday, yyyy, 8)
dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "Summer"
ret.Add(dn)
dn.Dat = New Date(yyyy, 12, 25, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 12, 27, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 12, 26, 12, 0, 0)
dn.name = "Christmas Day"
ret.Add(dn)
dn.Dat = New Date(yyyy, 12, 26, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 12, 27, 12, 0, 0)
If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 12, 28, 12, 0, 0)
dn.name = "Christmas Day"
ret.Add(dn)
Return ret
End Function
Private Shared Function First_Monday(w1 As WeekOfMonth, d1 As DayOfWeek, year As Integer, month As Integer) As Date
Dim dd, mm, yyyy As Integer
Dim dat As Date
If w1 = WeekOfMonth.Last Then
dat = New Date(yyyy, mm, Date.DaysInMonth(yyyy, mm), 12, 0, 0)
While dat.DayOfWeek <> d1
dat = dat.AddDays(-1)
End While
Return dat
End If
dd = 1
Select Case w1
Case WeekOfMonth.First : dd = 1
Case WeekOfMonth.Second : dd = 8
Case WeekOfMonth.Third : dd = 15
Case WeekOfMonth.Fourth : dd = 22
End Select
dat = New Date(yyyy, mm, dd, 12, 0, 0)
While dat.DayOfWeek <> d1
dat.AddDays(1)
End While
Return dat
End Function
Public Structure DateName
Dim Dat As Date
Dim name As String
End Structure
Public Structure WeekOfMonth
First
Second
Third
Fourth
Last
End Structure

 
Although some European countries change their clocks on the same day as the UK, the date/time or use of Summer Time could vary across Europe.
Although some North American countries/states change their clocks on the same day as the US, the date/time or use of Summer Time could vary across the Continent or even within the USA.
Private Shared Function Start_of_Summer_Time_UK(yyyy As Integer) As Date
' Last Sunday in March at 02:00
' start at 12:00 (avoid near midnight or near 02:00)
Dim dat As New Date(yyyy, 3, 31, 12, 0, 0)
While dat.DayOfWeek <> DayOfWeek.Sunday
dat = dat.AddDays(-1)
End While
' now we can set the time to 02:00
Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0)
End Function
'
Private Shared Function End_of_Summer_Time_UK(yyyy As Integer) As Date
' Last Sunday in October at 02:00
' start at 12:00 (avoid near midnight or near 02:00)
' Be aware that Date command may use local time-zones
Dim dat As New Date(yyyy, 10, 31, 12, 0, 0)
While dat.DayOfWeek <> DayOfWeek.Sunday
dat = dat.AddDays(-1)
End While
' now we can set the time to 02:00
Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0)
End Function
'
Private Shared Function Start_Of_Summer_Time_USA(yyyy As Integer) As Date
' Second Sunday in March at 02:00
' start at 12:00 (avoid near midnight or near 02:00)
' Be aware that Date command may use local time-zones
Dim dat As New Date(yyyy, 3, 8, 12, 0, 0)
While dat.DayOfWeek <> DayOfWeek.Sunday
dat = dat.AddDays(1)
End While
' now we can set the time to 02:00
Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0)
End Function
'
Private Shared Function End_Of_Summer_Time_USA(yyyy As Integer) As Date
' First Sunday in November at 02:00
' start at 12:00 (avoid near midnight or near 02:00)
' Be aware that Date command may use local time-zones
Dim dat As New Date(yyyy, 11, 1, 12, 0, 0)
While dat.DayOfWeek <> DayOfWeek.Sunday
dat = dat.AddDays(1)
End While
' now we can set the time to 02:00
Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0)
End Function


---