Simple Zeller's congruence to get day of week

Simple Zeller's congruence to get day of week - Printable Version

+- 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: Utilities (https://qb64phoenix.com/forum/forumdisplay.php?fid=8)
+---- Thread: Simple Zeller's congruence to get day of week (/showthread.php?tid=3034)

Pages: 1 2

Simple Zeller's congruence to get day of week - TDarcos - 09-15-2024

*** SPECIAL NOTICE *** I am editing this post on 9/16 to warn people reading this later that the Zeller's congruence formula I use below has an error. Whether that is because the formula was posted incorrectly or I copied it wrong, some dates it gets wrong, e.g. 12/31/2029, the program returns Tuesday, when the correct date is Monday. In any case, I accept sole responsibility for this error. Which means I did not change anything below, as owning one's mistakes means you don't hide them either.

I think this one is easier to understand than some of the others

Code: (Select All)



' Show-Date_and_Time.bas - Day of week computed using Zeller's congruence

' by Paul Robinson <paul@paul-robinson.us>

' September 15, 2024

' Dedicated to the Public Domain



Option _Explicit

Dim As String WeekDays(6), Months(12)

WeekDays(0) = "Saturday"

WeekDays(1) = "Sunday"

WeekDays(2) = "Monday"

WeekDays(3) = "Tuesday"

WeekDays(4) = "Wednesday"

WeekDays(5) = "Thursday"

WeekDays(6) = "Friday"

Months(1) = "January"

Months(2) = "February"

Months(3) = "March"

Months(4) = "April"

Months(5) = "May"

Months(6) = "June"

Months(7) = "July"

Months(8) = "August"

Months(9) = "September"

Months(10) = "October"

Months(11) = "November"

Months(12) = "December"



Dim As String CheckDate, CheckTime, AmPm

Dim As Integer Month, Day, Year, Hour, Minute, Second, WD

CheckDate = Date$

CheckTime = Time$

If CheckDate <> Date$ Then ' Midnight rolled over

    CheckDate = Date$

    CheckTime = Time$

End If

Month = Val(Left$(CheckDate, 2)): Day = Val(Mid$(CheckDate, 4, 2)): Year = Val(Right$(CheckDate, 4)):

Hour = Val(Left$(CheckDate, 2)): Minute = Val(Mid$(CheckDate, 4, 2)): Second = Val(Right$(CheckDate, 2))

WD = DayOfWeek(Month, Day, Year)



' Display date and time, formatted

Print "It is "; WeekDays(WD); " "; Months(Month); Str$(Day); ","; Year; " at";

$If MILITARYTIME Then

    print checktime

$Else

    AmPm = " AM"

    If Hour > 12 Then

        AmPm = " PM"

        Hour = Hour - 12

    End If

    Print Str$(Hour); ":"; Right$("0" + LTrim$(Str$(Minute)), 2); ":"; Right$("0" + LTrim$(Str$(Second)), 2); AmPm

$End If



End





' Returns 0=Saturday, etc.

Function DayOfWeek% (Month%, Day%, Year%)

    Dim As Integer I, J, K, D, M, Y

    D = Day%: M = Month%: Y = Year%

    If M < 3 Then

        M = M + 12

        Y = Y - 1

    End If

    K = Y Mod 100

    J = Y / 100

    DayOfWeek = (D + 13 * (M + 1) / 5 + K + K / 4 + J / 4 + 5 * J) Mod 7

End Function

A copy is attached to this message.

Some points

Line 5 indicates I waive copyright on this file.
Line 43 allows you to select military time format by having a line earlier in the program with "$LET MILITARY=-1". or drop the $IF block and keep the one you want (or make it a regular IF statement if the user gets to choose).
The string functions around day and hour/minute/second are to make sure that day and hour don't have a trailing space, and so that minute and second have no leading or trailing spaces, but do have leading 0 if <10.

RE: Simple Zeller's congruence to get day of week - Steffan-68 - 09-15-2024

(09-15-2024, 12:47 PM)TDarcos Wrote: I think this one is easier to understand than some of the others

Code: (Select All)



' Show-Date_and_Time.bas - Day of week computed using Zeller's congruence

' by Paul Robinson <paul@paul-robinson.us>

' September 15, 2024

' Dedicated to the Public Domain

Option _Explicit

Dim As String WeekDays(6), Months(12)

WeekDays(0) = "Saturday"

WeekDays(1) = "Sunday"

WeekDays(2) = "Monday"

WeekDays(3) = "Tuesday"

WeekDays(4) = "Wednesday"

WeekDays(5) = "Thursday"

WeekDays(6) = "Friday"

Months(1) = "January"

Months(2) = "February"

Months(3) = "March"

Months(4) = "April"

Months(5) = "May"

Months(6) = "June"

Months(7) = "July"

Months(8) = "August"

Months(9) = "September"

Months(10) = "October"

Months(11) = "November"

Months(12) = "December"

Dim As String CheckDate, CheckTime, AmPm

Dim As Integer Month, Day, Year, Hour, Minute, Second, WD

CheckDate = Date$

CheckTime = Time$

If CheckDate <> Date$ Then ' Midnight rolled over

    CheckDate = Date$

    CheckTime = Time$

End If

Month = Val(Left$(CheckDate, 2)): Day = Val(Mid$(CheckDate, 4, 2)): Year = Val(Right$(CheckDate, 4)):

Hour = Val(Left$(CheckDate, 2)): Minute = Val(Mid$(CheckDate, 4, 2)): Second = Val(Right$(CheckDate, 2))

WD = DayOfWeek(Month, Day, Year)

' Display date and time, formatted

Print "It is "; WeekDays(WD); " "; Months(Month); Str$(Day); ","; Year; " at";

$If MILITARYTIME Then

    print checktime

$Else

    AmPm = " AM"

    If Hour > 12 Then

        AmPm = " PM"

        Hour = Hour - 12

    End If

    Print Str$(Hour); ":"; Right$("0" + LTrim$(Str$(Minute)), 2); ":"; Right$("0" + LTrim$(Str$(Second)), 2); AmPm

$End If

End

' Returns 0=Saturday, etc.

Function DayOfWeek% (Month%, Day%, Year%)

    Dim As Integer I, J, K, D, M, Y

    D = Day%: M = Month%: Y = Year%

    If M < 3 Then

        M = M + 12

        Y = Y - 1

    End If

    K = Y Mod 100

    J = Y / 100

    DayOfWeek = (D + 13 * (M + 1) / 5 + K + K / 4 + J / 4 + 5 * J) Mod 7

End Function

A copy is attached to this message.
Some points

Line 5 indicates I waive copyright on this file.
Line 43 allows you to select military time format by having a line earlier in the program with "$LET MILITARY=-1". or drop the $IF block and keep the one you want (or make it a regular IF statement if the user gets to choose).
The string functions around day and hour/minute/second are to make sure that day and hour don't have a trailing space, and so that minute and second have no leading or trailing spaces, but do have leading 0 if <10.

beautifully done
But I found two errors.

1)

Code: (Select All)

Hour = Val(Left$(CheckDate, 2)): Minute = Val(Mid$(CheckDate, 4, 2)): Second = Val(Right$(CheckDate, 2))

That's probably what it should be called

Code: (Select All)

Hour = Val(Left$(CheckTime, 2)): Minute = Val(Mid$(CheckTime, 4, 2)): Second = Val(Right$(CheckTime, 2))

2)
Line 43 allows you to select military time format by having a line earlier in the program with "$LET MILITARY=-1". or drop the $IF block

That's probably how it should be

Line 43 allows you to select military time format by having a line earlier in the program with "$LET MILITARYTIM=-1". or drop the $IF block

RE: Simple Zeller's congruence to get day of week - TDarcos - 09-16-2024

@Steffan-68:
First, I do want to thank you for pointing out these mistakes. If I am releasing a program or module (a"module" being a SUB or FUNCTION), it should be as close to perfect as possible for me to make it. However, while you are correct that I probably should have done it that way, I don't believe they are full "errors" in the technical sense. An "error," as I see it, is a bug in which the program produces inaccurate results. (Syntax errors - which prevent a program from even compiling in the first place - are pretty much prevented by the IDE.) I would consider them style mistakes. I will fix them, though. I appreciate the feedback, and if you notice mistakes or errors in anything I release, I would be delighted if you report them. This means my program has caught the attention of someone who thinks it may be useful for some purpose.

RE: Simple Zeller's congruence to get day of week - TDarcos - 09-16-2024

Forget what I just said, I take the whole thing back, except for the thanks for telling me. They are errors, at least the first one is, and I know exactly how I did it. I don't know about you, but when I have a piece of code that will do the exact same function in another place, I will copy, paste, then change to fit the new circumstances. I take full responsibility for the error. I should have checked more closely that the output is correct, and if I hadn't been sloppy, I would have noticed. That is not an excuse, by the way, as I said, I take full responsibility, I made the mistake, included an error where I shouldn't have, and I will fix it.

I guess it proves that my signature is right!

RE: Simple Zeller's congruence to get day of week - TDarcos - 09-16-2024

I just ran the program to check, and it says, right now, that it is 9:16:24 AM and if i run it 10 minutes later, or any time, day or night, it will still report the same time. I don't know about you, but if it's 9:16 in the morning, and the window to the outside shows it's pitch black, something really weird is going on!

RE: Simple Zeller's congruence to get day of week - JRace - 09-16-2024

(09-16-2024, 09:15 AM)TDarcos Wrote: I just ran the program to check, and it says, right now, that it is 9:16:24 AM and if i run it 10 minutes later, or any time, day or night, it will still report the same time. I don't know about you, but if it's 9:16 in the morning, and the window to the outside shows it's pitch black, something really weird is going on!

Sounds like the program is written for some other part of the world where all the clocks have stopped.

Like the song says, "it's five o'clock somewhere."

RE: Simple Zeller's congruence to get day of week - TDarcos - 09-16-2024

I have fixed the program. The error about $SET MILITARYTIME=1 if you want to use that, was already in the program, and listed here, we were both wrong! I referred to it as $SET MILITARY=1 but you referred to it as $SET MILITARYTIM=1. I'm not nitpicking, I do appreciate how you found my error. Oh hell, I probably am nitpicking.

Speaking of nitpicking, I discovered a minor error. On line 42 of my original program, and line 39 of Steffan-68's corrected version (he drops some blank lines I used, that's a styling opinion), there should be a comma and space following the day, not just a space. That is also fixed, on line 47 of the revised version.

I also forgot to mention another feature of the program, which I'll mention after the listing.

Code: (Select All)



' Show-Date_and_Time.bas - Day of week computed using Zeller's congruence

' by Paul Robinson <paul@paul-robinson.us>

' September 15, 2024

' Dedicated to the Public Domain



' I'd like to thank user Steffan-68 from the QB64 Phoenix Edition Forums

' for his catching some errors I made

' September 16, 2024



Option _Explicit

Const Program_Version = "1.1" '  In case I have to fix it again...

Dim As String WeekDays(6), Months(12)

WeekDays(0) = "Saturday"

WeekDays(1) = "Sunday"

WeekDays(2) = "Monday"

WeekDays(3) = "Tuesday"

WeekDays(4) = "Wednesday"

WeekDays(5) = "Thursday"

WeekDays(6) = "Friday"

Months(1) = "January"

Months(2) = "February"

Months(3) = "March"

Months(4) = "April"

Months(5) = "May"

Months(6) = "June"

Months(7) = "July"

Months(8) = "August"

Months(9) = "September"

Months(10) = "October"

Months(11) = "November"

Months(12) = "December"



Dim As String CheckDate, CheckTime, AmPm

Dim As Integer Month, Day, Year, Hour, Minute, Second, WD

CheckDate = Date$

CheckTime = Time$

If CheckDate <> Date$ Then ' Midnight rolled over

    CheckDate = Date$

    CheckTime = Time$

End If

Month = Val(Left$(CheckDate, 2)): Day = Val(Mid$(CheckDate, 4, 2)): Year = Val(Right$(CheckDate, 4)):

Hour = Val(Left$(CheckTime, 2)): Minute = Val(Mid$(CheckTime, 4, 2)): Second = Val(Right$(CheckTime, 2))

WD = DayOfWeek(Month, Day, Year)



' Display date and time, formatted

Print "It is "; WeekDays(WD); ", "; Months(Month); Str$(Day); ","; Year; " at";

$If MILITARYTIME Then

    print checktime

$Else

    AmPm = " AM"

    If Hour > 12 Then

        AmPm = " PM"

        Hour = Hour - 12

    End If

    Print Str$(Hour); ":"; Right$("0" + LTrim$(Str$(Minute)), 2); ":"; Right$("0" + LTrim$(Str$(Second)), 2); AmPm

$End If



End





' Returns 0=Saturday, etc.

Function DayOfWeek% (Month%, Day%, Year%)

    Dim As Integer I, J, K, D, M, Y

    D = Day%: M = Month%: Y = Year%

    If M < 3 Then

        M = M + 12

        Y = Y - 1

    End If

    K = Y Mod 100

    J = Y / 100

    DayOfWeek = (D + 13 * (M + 1) / 5 + K + K / 4 + J / 4 + 5 * J) Mod 7

End Function

Now the one feature I forgot to mention is on lines 31-36 of my original, lines 29-34 of Stefan-68's correction, and on lines 36-41 of the revised version, you'll notice I reference DATE$ three times. The check of the date string against the current date, and then getting the date and time again if it changed, is a safety feature in the extremely rare, improbable case that it was exactly midnight when the time was captured, and the date just happened to change immediately after. I make sure I protect against any foreseeable error, 'improbable' is not the same as 'impossible,' and I always assume the universe will go after me or my creations at any chance it can get, and this eliminates that chance.

I know, I calculated the speed of a date/time collection, about 30 years ago, and on a typical 4.77 mhz PC running interpreted Basic, it could collect over 2000 pairs in one second and a compiled Turbo Pascal program could do about 6,000, so statistically the probability is about once in 16 years. Today, with PCs over 800 times faster, the chance it could happen is extremely improbable. But again, improbable does not mean impossible.

If a program is using the Windows GetLocalTime function, however, it is atomic, both are collected simultaneously, so in that case it is impossible for the scenario to happen.

RE: Simple Zeller's congruence to get day of week - euklides - 09-16-2024

This little code calculate the week day and gives the julian date.

Code: (Select All)
Datum: Input "DATE in form MMDDYYYY or nothing to stop"; k$

If Len(k$) <> 8 Then End

M# = Val(Left$(k$, 2)): J# = Val(Mid$(k$, 3, 2)): A# = Val(Right$(k$, 4))

If J# < 1 Or J# > 31 Or M# < 1 Or M# > 12 Then Print " Date not correct": GoTo Datum

GoSub GJ

Print jour$; M#; "/"; J#; "/"; A#; "/ julian-->"; jj#

Print "----------------"

GoTo Datum

GJ: XXJ# = J#: XXA# = A#: XXM# = M#: J# = J# + .5: C# = 1720994.5#: Y# = Int(A# / 100) - 6: If M# < 3 Then A# = A# - 1

M# = M# + 1: If M# < 4 Then M# = M# + 12

If A# > 0 Then If M# < 3 Then A# = A# - 1

jj# = Int(365.25 * A#) + Int(30.6001 * M#) + J# + C# - Y#

If XXA# > 1999 Then jj# = jj# + 1

D# = jj# - 2299162#: D# = jj# / 7 - Int(jj# / 7): D# = Int((D# + .01) * 7)

jour$ = "Monday  Tuesday  WednesdayThursday Friday  Saturday Sunday  "

jour$ = RTrim$(Mid$(jour$, D# * 9 + 1, 9)): J# = XXJ#: M# = XXM#: A# = XXA#: Return

RE: Simple Zeller's congruence to get day of week - SMcNeill - 09-16-2024

I present to you -- Everything Date$: https://qb64phoenix.com/forum/showthread.php?tid=2103

RE: Simple Zeller's congruence to get day of week - SMcNeill - 09-16-2024

Code: (Select All)
CheckDate = Date$

CheckTime = Time$

If CheckDate <> Date$ Then ' Midnight rolled over

    CheckDate = Date$

    CheckTime = Time$

End If

I don't think the above is going to catch any Midnight roll over for you. Follow along with me and think of this little scenario:

CheckDate = Date$ '23:59.9998 time (HH:MM:SSSS)
CheckTime = Time$ '23:59.9998 time
If CheckDate <> Date$ Then ' 23:59.9999 time ==> OH NOS! TIME DOESN'T MATCH! GET NEW TIME!
CheckDate = Date$ ' 23:59.9999 time
CheckTime = Time$ ' 00:00.0000 time <-- Midnight just rolled over between those times!
End If[/code]

As you can see, you're not preventing the Date from falling behind. If it can fall behind after the first CheckDate = Date$ assignment, then why can't it fall behind at the second CheckDate = Date$ assignment?

Seems to me like the only way to do what you're wanting would be to verify the date again before the PRINT statement. Check the CheckDate$ vs Date$ there, and if it's not the same at that point, then redo the process with the new date...

(And yet, that can't catch 100% of all date change errors, as the date might change in the millisecond after that check, and while the PRINT is printing the date...)

Sometimes you just have to shrug and say, "Close enough is close enough."