More Problems with (implementations of) Zeller's congruence

[TDarcos]

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="; DayStart

Now, 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 ) = Saturday

Now, this continues on for, get this, 146,083 lines! Here's the bottom 10 lines, lines 196,094 through 146,103:

Code: (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

So while the program worked, I could just imagine trying to give the QB64PE compiler a behemoth 5,113,223 byte, 146,103 line, file. If it could even handle it, how long it would take to compile? And then, at run time, how long it would take for the program to initialize all these arrays? So, I got thinking, I'm already creating these initialization records, how long would it take to just have the program initialize itself? Let's find out!

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.

[mdijkens]

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...

[TDarcos]

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