More Problems with (implementations of) Zeller's congruence

[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