10-23-2024, 05:04 PM
(This post was last modified: 10-23-2024, 05:14 PM by TDarcos.
Edit Reason: ADD COMMENT
)
After my recent debacles with getting a Zeller's congruence (determine day of week from date) formula, I repeated my foray into software archeology, by searching my collection of 90,142 files (many being zip files) and more than 12 gb of Basic source and basic-related files, I found an old file that purports to return day of week from date. It was old enough to be from the days when Basic programs had to have line numbers:
The operative part of the above program is lines numbered 120-150. So, I have this:
Let's run it and see how accurate it is:
Program begins, Wednesday, October 23, 2024 at 12:55:05
Initialization: Collecting dates from 1-1-1800 to 12-31-9999
Please wait while initialization is completed
Initialization completed; 2994988 records initialized.
Initialization took .09 seconds.
A check will be made to see how accurate the Zeller's congruence algorhythm is.
January 1, 1800 was a Wednesday, the algorhythm says it was Wednesday.
Now let's see how accurate it is:
Completed with NO errors.
There were 2994988 date computations.
I believe this certifies the algorhythm is accurate.
Code: (Select All)
_Title "Possibly_accurate_zellers_congruence"
10 ' DAYOPFWK = Calculates the day of the week given date
20 '
30 Cls: Print
40 Print " This routine calculates the day of the week given the date"
50 Dim DAYS$(6): For I = 0 To 6: Read DAY$(I): Next
60 Data Saturday,Sunday,Monday,Tuesday,Wednesday,Thursday,Friday
70 Line Input "Enter date as mm/dd/yyyy "; EDATE$: S$ = EDATE$
80 PS = InStr(S$, "/"): MONTH = Val(Left$(S$, PS - 1)): S$ = Mid$(S$, PS + 1)
90 PS = InStr(S$, "/"): DAY = Val(Left$(S$, PS - 1)): S$ = Mid$(S$, PS + 1)
100 YEAR = Val(S$)
110 '
120 If MONTH > 2 Then 140
130 MONTH = MONTH + 12: YEAR = YEAR - 1
140 N = DAY + 2 * MONTH + Int(.6 * (MONTH + 1)) + YEAR + Int(YEAR / 4) - Int(YEAR / 100) + Int(YEAR / 400) + 2
150 N = Int((N / 7 - Int(N / 7)) * 7 + .5)
160 Print DAY$(N)
The operative part of the above program is lines numbered 120-150. So, I have this:
Code: (Select All)
' Date_testbed.bas - load every date and test a Zeller's congrence algorithm for correctness
' Paul Robinson October 23, 2024
Option _Explicit
_Title "Zeller_testbed"
' The system time function can be used from QB64, I was mistaken it could not
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Declare Dynamic Library "kernel32"
Function GetLocalTime& (lpSystemTime As SYSTEMTIME)
Function GetLastError& ()
Function FormatMessageA& (ByVal f As Long, f$, Byval e As Long, Byval d As Long, g$, Byval s As Long, h$)
End Declare
Dim As SYSTEMTIME StartTime, EndTime
Dim TimeString As String
Color 15
Cls
Const Saturday = 0
Const Sunday = Saturday + 1
Const Monday = Sunday + 1
Const Tuesday = Monday + 1
Const Wednesday = Tuesday + 1
Const Thursday = Wednesday + 1
Const Friday = Thursday + 1
Const January = 1, February = 2, March = 3, April = 4, May = 5, June = 6
Const July = 7, August = 8, September = 9, October = 10, November = 11, December = 12
Const LimitYear = 9999
Dim Shared YD(1800 To LimitYear, December, 31) As Integer
' Dim As Integer Month
Dim Shared As Integer Year, Month, Day, Hour, Minute, Second, Leap
'Dim Shared Year$, Month$, Day$, WeekDay$, Minute$, Second$, AmPm$
'Dim Shared As String DateString
Dim As Integer DayStart, I, WindowsOffset, ZellersOffset
Dim As Long RecCount
' these use 1-12 for convenience
Dim Shared MonthDays(1, December) As Integer, MonthNames(December) As String
' This one uses 0
Dim Shared DayNames(12) As String
Data "January",31,"February",28,"March",31,"April",30,"May",31
Data "June",30,"July",31,"August",31,"September",30
Data "October",31,"November",30,"December",31
Data "Saturday","Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday","Monday","Tuesday","Wednesday","Thursday"
For Month = January To December: Read MonthNames(Month), MonthDays(0, Month): Next
For Month = January To December: MonthDays(1, Month) = MonthDays(0, Month): Next ' Leap years
For Day = 0 To 12: Read DayNames(Day): Next
' We start Saturday =0 as most Zeller's congruence algorhythms do
' If either the test routine or Windows starts any other day, add the offset
WindowsOffset = 1 ' Windows starts Sunday
ZellersOffset = 0 ' The Zeller's Congruence starts Saturday
MonthDays(1, February) = 29 'Adjust for leap year
' Start the clock
I = GetLocalTime(StartTime)
TimeString = DayNames(StartTime.wDayOfWeek + WindowsOffset) + ", "
TimeString = TimeString + " " + MonthNames(StartTime.wMonth)
TimeString = TimeString + Str$(StartTime.wDay) + "," + Str$(StartTime.wYear) + " at"
TimeString = TimeString + Str$(StartTime.wHour) + ":"
TimeString = TimeString + Right$("0" + LTrim$(Str$(StartTime.wMinute)), 2) + ":"
TimeString = TimeString + Right$("0" + LTrim$(Str$(StartTime.wSecond)), 2)
Open "L:\ZteatResults.txt" For Output As #1
DPrint "Program begins, " + TimeString
DPrint "Initialization: Collecting dates from 1-1-1800 to 12-31-" + LTrim$(Str$(LimitYear))
DPrint "Please wait while initialization is completed"
Dim As _Byte ok, PP, Sc, InitialDay
ok = -1
InitialDay = Wednesday ' January 1, 1800
DayStart = InitialDay
RecCount = 0
PP = 0
For Year = 1800 To LimitYear
' Leap Year Calcultions
GoSub GetLeap
' Now count the days
For Month = January To December
For Day = 1 To MonthDays(Leap, Month) ' if leap year, uses alternate
YD(Year, Month, Day) = DayStart
DayStart = DayStart + 1
RecCount = RecCount + 1
If DayStart = 7 Then DayStart = 0
Next
Next
Next
I = GetLocalTime(EndTime) ' Stop the clock
' Compute elapsed time
Hour = EndTime.wHour
If StartTime.wHour < EndTime.wHour Then Hour = Hour + 24
Hour = Hour - StartTime.wHour
Minute = EndTime.wMinute
If StartTime.wMinute < EndTime.wMinute Then Minute = Minute + 60: Hour = Hour - 1
Minute = Minute - StartTime.wMinute
Second = EndTime.wSecond
If StartTime.wSecond < EndTime.wSecond Then Minute = Minute - 1: Second = Second + 60
Second = Second - StartTime.wSecond
Dim As Single St, Et
Et = EndTime.wMilliseconds / 1000
St = StartTime.wMilliseconds / 1000
If Et < St Then Second = Second - 1: Et = Et + 1
Et = (Et - St)
TimeString = ""
If Hour > 0 Then
TimeString = Str$(Hour) + "hour"
If Hour <> 1 Then TimeString = TimeString + "s"
TimeString = TimeString + " "
End If
If Minute > 0 Then
TimeString = TimeString + Str$(Minute) + "minute"
If Minute <> 1 Then TimeString = TimeString + "s"
TimeString = TimeString + " "
End If
If TimeString <> "" Then TimeString = TimeString + "and "
If Second < 0 Then Second = 0
TimeString = TimeString + LTrim$(Str$(Second + Et)) + " seconds."
DPrint "Initialization completed;" + Str$(RecCount) + " records initialized. "
DPrint "Initialization took " + TimeString
Second = Hour * 3600 + Minute * 60 + Second
Dim As Integer ProcessCount
If Second + Et > 3 Then
ProcessCount = RecCount / (Second + Et)
DPrint "Initilization rate was approx. " + Str$(ProcessCount) + "records per second."
End If
DPrint ""
DPrint "A check will be made to see how accurate the Zeller's congruence algorhythm is."
' Insert code to test here
Dim DOW As Single
Month = 1
Day = 1
Year = 1800
I = 0
GoSub Zeller
DPrint "January 1, 1800 was a " + DayNames(YD(Year, Month, Day)) + ", the algorhythm says it was " + DayNames(DOW) + "."
If YD(Year, Month, Day) <> DOW Then DPrint "": DPrint "Algorhythm fails.": Close: End
Locate 10, 1
DPrint "Now let's see how accurate it is:"
Locate 12, 1
Print "Year"
RecCount = 0
For Year = 1800 To LimitYear
Locate 12, 5
Print Year
Leap = 0
GoSub GetLeap
For Month = January To December
For Day = 1 To MonthDays(Leap, Month)
GoSub Zeller
If DOW <> YD(Year, Month, Day) + ZellersOffset Then
Locate 15, 1
Color 4
DPrint "Mismatch on " + MonthNames(Month) + Str$(Day) + ", " + Str$(Year)
DPrint "Precalc is :" + DayNames(YD(Year, Month, Day) + ZellersOffset) + " but Zeller says " + DayNames(DOW + ZellersOffset)
Color 15
I = I + 1
End If
Next
Next
Next
Locate 17, 1
Dim ERCMsg$
If I = 0 Then ERCMsg$ = "NO " Else ERCMsg$ = Str$(I)
DPrint "Completed with " + ERCMsg$ + "errors."
DPrint "There were " + Str$(RecCount) + " date computations."
DPrint ""
If I = 0 Then
DPrint ""
DPrint "I believe this certifies the algorhythm is accurate."
Else
DPrint "Algorhythm fails."
End If
Close
End
GetLeap:
' Leap Year Calcultions
Leap = 0
' Year mod 4 = 0 for a leap year (in most cases)
If Year Mod 4 = 0 Then ' It is virtually certain it is a leap year with one exception
' If it is a century year (year where last two digits are 00)
If Year Mod 100 <> 0 Then ' Not a century year
Leap = 1 ' regular leap year
Else ' It is a century year, it must also be divisible by 400
If Year Mod 400 = 0 Then Leap = 1 ' Century leap year
End If
End If
Return
Dim As Integer Zmonth, ZYear
Zeller:
If Month < 3 Then
Zmonth = Month + 12
ZYear = Year - 1
Else
Zmonth = Month
ZYear = Year
End If
DOW = Day + 2 * Zmonth + Int(.6 * (Zmonth + 1)) + ZYear + Int(ZYear / 4) - Int(ZYear / 100) + Int(ZYear / 400) + 2
DOW = Int((DOW / 7 - Int(DOW / 7)) * 7 + .5)
RecCount = RecCount + 1
Return
' Text output can't be captured off screen through
' mouse or hilighting, so we also print to a file
Sub DPrint (P$)
Print P$
Print #1, P$
End Sub
Let's run it and see how accurate it is:
Program begins, Wednesday, October 23, 2024 at 12:55:05
Initialization: Collecting dates from 1-1-1800 to 12-31-9999
Please wait while initialization is completed
Initialization completed; 2994988 records initialized.
Initialization took .09 seconds.
A check will be made to see how accurate the Zeller's congruence algorhythm is.
January 1, 1800 was a Wednesday, the algorhythm says it was Wednesday.
Now let's see how accurate it is:
Completed with NO errors.
There were 2994988 date computations.
I believe this certifies the algorhythm is accurate.
While 1
Fix Bugs
report all bugs fixed
receive bug report
end while
Fix Bugs
report all bugs fixed
receive bug report
end while