+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: More Problems with (implementations of) Zeller's congruence (/showthread.php?tid=3041)
More Problems with (implementations of) Zeller's congruence - TDarcos - 09-17-2024
If you saw my posting on a simpler method to perform Zeller's congruence (the means to compute what day of the week a particular date falls on), you'll find I discovered that the formula has errors. So, having been embarrassed, I decided to look in my archives and do some software archeology. I discover a program I wrote literally six months ago, that does the same thing, only it uses a different method to perform Zeller's congruence. I run that program, and it has errors too!
So I decided to create a test bed, where it would have all the correct dates from 1/1/1800 (which was a Wednesday), all the way to 12/31/2199 (which will be a Tuesday), already loaded into itself, then have any Zeller's congruence routine go through every single date. If it passes all of these tests, then I can consider it correct.
Well, am I going to do this manually? Are you kidding? No serious programmer is going to do work he can shove off onto the computer. So I wrote a program to do it for me. After a few fits and starts and a rewrite of a handful (less than 10 lines to correct) I got the program to work perfectly (I had it give me snapshots of what it was doing, and I verified a few, everything was correct). At least, until I saw the results. It had generated a four megabyte file!
The program is named zeller_check.bas, and in case you're interested in a program that writes other programs, take a look here. Or download it (a copy is attached to this posting) and try it yourself.
Code: (Select All)
' ZCFC - Zeller's congruence Fact Checker
'
' Creates a table of the entire range of dates from 1800-01-01 to 2199-12-31
' Paul Robinson September 16, 2024
Option _Explicit
Dim As Long DC, Y, LC, TY, W, L
Dim As Integer Month, Day, DayStart
Dim A$
Dim YD(1800 To 2199, 12, 31)
'Print " Y Y/4 Y\4 Mod4 /100 \100 Mod /400 \400 Mod"
'For Y = 1899 To 2000
' Print Using "####: #### #### #### #### #### #### #### #### ####"; Y; Y / 4; Y \ 4; Y Mod 4; Y / 100; Y \ 100; Y Mod 100; Y / 400; Y \ 400; Y Mod 400
' If Y = 1908 Or Y = 1950 Then Input "More"; A$: Print " Y Y/4 Y\4 Mod4 /100 \100 Mod /400 \400 Mod"
'Next
Open "L:\yeardays.bas" For Output As #1
Print #1, "Dim YearDays(1800 To 2199) as integer"
Open "L:\datemame.bas" For Output As #2
Color 15
Const Mo = 0, Tu = 1, We = 2, Th = 3, Fr = 4, Sa = 5, Su = 6
Const Monday = 0, Tuesday = 1, Wednesday = 2, Thursday = 3
Const Friday = 4, Saturday = 5, Sunday = 6
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
Print #2, "Const Mo = 0, Tu = 1, We = 2, Th = 3, Fr = 4, Sa = 5, Su = 6"
Print #2, "Const Monday = 0, Tuesday = 1, Wednesday = 2, Thursday = 3"
Print #2, "Const Friday = 4, Saturday = 5, Sunday = 6"
Print #2, "Const January = 1, February = 2, March = 3, April = 4, May = 5, June = 6"
Print #2, "Const July = 7, August = 8, September = 9, October = 10, November = 11, December = 12"
Print #2, "Dim YD(1800 To 2199, December, 31)"
' these use 1-12 for convenience
Dim MonthDays(1, December) As Integer, MonthNames(December) As String
' This one uses 0
Dim DayNames(Sunday) 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 "Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"
For Month = January To December: Read MonthNames(Month), MonthDays(0, Month): Next
For Month = January To December: MonthDays(1, Month) = MonthDays(0, Month): Next
MonthDays(1, February) = 29 'Adjust for leap year
For Day = Monday To Sunday: Read DayNames(Day): Next
' Jan 1 1800 was a Wednesday
DayStart = Wednesday
For Y = 1800 To 2199
L = 0 ' not determined if leap year; presume it is not
' Count the number of days in a year
TY = 365
' Year mod 4 =0 for a leap year
If Y Mod 4 = 0 Then
If Y Mod 100 <> 0 Then
TY = TY + 1 ' Regular leap year
L = 1
Color 4
Else
If Y Mod 400 = 0 Then TY = TY + 1: L = 1: Color 4 ' Century leap year
End If
End If
DC = DC + TY
Print Using "#### ### "; Y; TY;
Print #1, "YearDays("; Y; ") = "; TY
Color 15
LC = LC + 1
If LC = 6 Then LC = 0: Print: W = W + 1
If W = 10 Then Input "More"; A$: W = 0
For Month = January To December
On Error GoTo Catch
For Day = 1 To MonthDays(L, Month) ' if leap year, uses alternate
Print #2, " YD("; Y; ","; MonthNames(Month); ","; Day; ") = ";
Print #2, DayNames(DayStart)
If Day = 1 And Month = 1 Then Print MonthNames(Month); " 1,"; Y; "="; DayNames(DayStart)
DayStart = DayStart + 1
If DayStart = 7 Then DayStart = Monday
Next
Next
Next
Print DC; "days."
Close
End
Catch:
Print: Print " ERROR "; Err; " DayStart="; DayStartNow, a couple of things about the program. "Monthdays" was originally a 1-dimensional array, but I was getting errors - it was not tracking the day of the week correctly. Then it hit me: I wasn't accounting for leap years! So, I got thinking, I already have L to determine if it is a leap year. So I changed Monthdays to a two-dimensional array, load the number of days in a month into dimension 0, i.e. Monthdays(0,1) to Monthdays (0,12). Now copy the array into dimension, then change Monthdays(1,2) to 29, which I do on line 48. Then use Monthdays(0,1 to 12) for common years, and Monthdays(1, 1 to 12) for leap years.
Now it worked perfectly. Here's a sample, top of the file:
Code: (Select All)
Const Mo = 0, Tu = 1, We = 2, Th = 3, Fr = 4, Sa = 5, Su = 6
Const Monday = 0, Tuesday = 1, Wednesday = 2, Thursday = 3
Const Friday = 4, Saturday = 5, Sunday = 6
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
Dim YD(1800 To 2199, December, 31)
YD( 1800 ,January, 1 ) = Wednesday
YD( 1800 ,January, 2 ) = Thursday
YD( 1800 ,January, 3 ) = Friday
YD( 1800 ,January, 4 ) = SaturdayCode: (Select All)
YD( 2199 ,December, 19 ) = Thursday
YD( 2199 ,December, 20 ) = Friday
YD( 2199 ,December, 21 ) = Saturday
YD( 2199 ,December, 22 ) = Sunday
YD( 2199 ,December, 23 ) = Monday
YD( 2199 ,December, 24 ) = Tuesday
YD( 2199 ,December, 25 ) = Wednesday
YD( 2199 ,December, 26 ) = Thursday
YD( 2199 ,December, 27 ) = Friday
YD( 2199 ,December, 28 ) = Saturday
YD( 2199 ,December, 29 ) = Sunday
YD( 2199 ,December, 30 ) = Monday
YD( 2199 ,December, 31 ) = Tuesday
And since this is a forum on "work in progress", I'll be back with part 2 of this story, after I take this program apart and have it initialize itself. We'll find out the answer to that question, in the next episode.
RE: More Problems with (implementations of) Zeller's congruence - mdijkens - 09-17-2024
I've posted my TIM library some time ago, that does all kind of date/time calculations and also provides day of week:
TIM lib code
Maybe you find something interesting in there...
RE: More Problems with (implementations of) Zeller's congruence - TDarcos - 09-17-2024
And now, part 2.
I started with pieces of the old program to construct a new testbed for Zeller's congruence algorithms and itmorphed into something else. I got it to create an array with every date from 1-1-1800 to 12-31-2199. Basically, it was no sweat for it to 1oad >140,000 date values.
In the meantime, I discovered that maybe I never really had to do this in the first place. Among many of my mistaken impressions was one that one could not use Windows' GetLocalTime function of Kernel32.dll from QB64PE as any usage conflicts with internal use by the compiler, causing the C compiler QB64PE uses, to fault with its own compiler error message. But again, while doing software archeology on my massive source code collection, I found some code that does that. What this means is I can access the day of week field to get the current day, thus (or thud, as the realization hits) that I never needed a Zeller's congruence to get the day of the week for today..
But in any event, I was having some problems with the scanning program because (of the above discovery) I decided to switch to Windows day numbering (in order to use the day of week data it provides). The original formula had 0 for Monday and 6 for Sunday. Being from the US, of course, Windows numbers Sunday as 0 and Saturday as 6. Once I got it straightened out, it synchronized date and day of week perfectly.
I wanted to see how long it would take to load the 10s of thousands of dates, and I was a bit amazed, it timed out to .01 second! So I decided to change it, by making the maximum number of years to be reset-able by changing a manifest constant and recompiling. i tried increasing the number of years it stored, and I turned it into a "What day is this date?" program. So I pushed the high end from 2199 to 2999, and had it count how many dates it had stored. I decided to see how large I could make it until either took longer than 1 second to load them all, or I ran out of memory.
I raised the limit, to the year 9,999, then to 19,999. (Even Zager and Evans 1969 song In the Year 2525 stops at 10,000.) Finally, I gave up. I had it go up to the year 32,767, it has over 11 million records, and get this: it takes .27 seconds to construct the table. Not 27 seconds, but 27/100 of one second! Using Task Manager it uses about 67 megabytes of memory. Yet the executable file is only about the minimum for a program compiled using QB64PE, a little over 2 megabytes.
With this sort of "brute force attack" taking so little time, it probably makes little sense to look for a Zeller's congruence algorithm on large, fast desktop PCs. On slower and memory-constrained systems, that sort of algorithm then makes a lot of sense.
For anyone who wants to play with it, here is the program to look at, and you can download the attachment if you wish. I don't know if it has practical applications, but its here in case someone thinks of one.
Code: (Select All)
' Date_scanner.ba - load every date and report the ay of week for as many as several million days
' originlly a Program to test Zeller's congrence algorithms for correctness
' Paul Robinson September 17, 2024
Option _Explicit
' 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
Const Mo = 0, Tu = 1, We = 2, Th = 3, Fr = 4, Sa = 5, Su = 6
Const Sunday = 0
Const Monday = Sunday + 1
Const Tuesday = Monday + 1
Const Wednesday = Tuesday + 1
Const Thursday = Wednesday + 1
Const Friday = Thursday + 1
Const Saturday = Friday + 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 = 32767
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
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(Saturday) 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 "Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"
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 = Sunday To Saturday: Read DayNames(Day): Next
MonthDays(1, February) = 29 'Adjust for leap year
' Start the clock
I = GetLocalTime(StartTime)
Open "L:\zeller_test.txt" For Output As #1
TimeString = DayNames(StartTime.wDayOfWeek)
TimeString = TimeString + " " + MonthNames(StartTime.wMonth)
TimeString = TimeString + Str$(StartTime.wDay) + "," + Str$(StartTime.wYear)
Print #1, "Zeller's congruence accuracy test, performed "; TimeString
Print "Program begins, "; TimeString
Print "Initialization: Collecting dates from 1-1-1800 to 12-31-"; LTrim$(Str$(LimitYear))
Print "Please wait while initialization is completed"
Dim As _Byte ok, PP, Sc
ok = -1
DayStart = Wednesday ' January 1, 1800
RecCount = 0
PP = 0
For Year = 1800 To LimitYear
Leap = 0 ' not determined if leap year; presume it is not
' Leap Year Calcultions
' Year mod 4 =0 for a leap year
If Year Mod 4 = 0 Then
If Year Mod 100 <> 0 Then ' Not a century year
Leap = 1 ' regular leap year
Else
If Year Mod 400 = 0 Then Leap = 1 ' Century leap year
End If
End If
' 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
'If ok Then
' Print "("; Year; ","; Month; ","; Day; "-"; DayStart; "); ";
' If PP = 5 Then
' Print
' PP = 0
' Sc = Sc + 1
' End If
' If Sc = 10 Then
' Print
' Input "ok(0=no,-1=yes)"; ok
' End If
'End If
DayStart = DayStart + 1
RecCount = RecCount + 1
'PP = PP + 1
If DayStart = 7 Then DayStart = Sunday
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 MS As Integer
MS = EndTime.wMilliseconds
If StartTime.wMilliseconds < EndTime.wMilliseconds Then MS = MS + 1: Second = Second - 1
MS = MS - StartTime.wMilliseconds
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 + (MS / 1000))) + " seconds."
Print "Initialization completed;"; Str$(RecCount); " records initialized; "
Print "Initialization took "; TimeString
Second = Hour * 3600 + Minute * 60 + Second
Dim As Integer ProcessCount
If Second + (MS / 1000) > 3 Then
ProcessCount = RecCount / (Second + (MS / 1000 + 0.5))
Print "Initilization rate was approx. "; Str$(ProcessCount); "records per second."
End If
' Insert code to test here
' Demo
Print: Print
Dim As Integer Mt, Dt, Yt, FAIL
Dim As String DateType
Print "Date validity test"
Do
FAIL = 0
Leap = 0
Print "Enter date in the form month,day,year where year = 1800 to"; Str$(LimitYear); "; 0,0,0 to end"
Input "Date"; Mt, Dt, Yt
If Mt = 0 Or Dt = 0 Or Yt = 0 Then Exit Do
If Yt < 1800 Or Yt > LimitYear Then
Print "Bad year": FAIL = -1
Else
If Mt < 1 Or Mt > 12 Then Print "?Bad month": FAIL = -1
If Dt < 1 Or Dt > 31 Then Print "?Bad day": FAIL = -1
If Not FAIL Then
If Yt > StartTime.wYear Then
DateType = "will be"
ElseIf Yt < StartTime.wYear Then
DateType = "was"
Else ' same year
If Mt > StartTime.wMonth Then
DateType = "will be"
ElseIf Mt < StartTime.wMonth Then
DateType = "was"
Else ' same month
If Dt > StartTime.wDay Then
DateType = "will be"
ElseIf Dt < StartTime.wDay Then
DateType = "was"
Else
DateType = "is today, and is"
End If
End If
End If
If Yt Mod 4 = 0 Then
If Yt Mod 100 <> 0 Then ' Not a century year
Leap = 1 ' regular leap year
Else
If Yt Mod 400 = 0 Then Leap = 1 ' Century leap year
End If
End If
If Dt < 1 Or Dt > MonthDays(Leap, Mt) Then
Print "?Day"; Dt; "not valid in "; MonthNames(Mt); Yt
Else
Print MonthNames(Mt); Str$(Dt); ","; Yt; DateType; " a "; DayNames(YD(Yt, Mt, Dt)); "."
End If
End If
End If
Print
Loop
Print
Print "Goodbye."
End