43 lines
1.4 KiB
Text
43 lines
1.4 KiB
Text
\Finds the day of the week of a date using John Conway's Doomsday rule.
|
|
\Returns the day of the week (Sunday = 0, Monday = 1,...) for the date
|
|
\ specified by CCYY, MM and DD.
|
|
function DOW ( CCYY, MM, DD );
|
|
integer CCYY, MM, DD;
|
|
integer Doomsday, AnchorDay, LeapYear, Dooms;
|
|
begin
|
|
Doomsday := rem(( \Tuesday \2
|
|
+ 5 * rem( CCYY/4 )
|
|
+ 4 * rem( CCYY/100 )
|
|
+ 6 * rem( CCYY/400 )
|
|
) / 7);
|
|
LeapYear := rem(CCYY/4) = 0 and ( rem(CCYY/100) # 0 or rem(CCYY/ 400) = 0 );
|
|
Dooms := [[4, 1, 7, 4, 2, 6, 4, 1, 5, 3, 7, 5],
|
|
[3, 7, 7, 4, 2, 6, 4, 1, 5, 3, 7, 5]];
|
|
AnchorDay := Dooms(if LeapYear then 0 else 1, MM-1);
|
|
return rem( ( Doomsday + ( DD - AnchorDay ) + 7 ) / 7);
|
|
end; \DOW
|
|
|
|
\Prints a test date and its day of the week
|
|
procedure TestDOW ( CCYY, MM, DD );
|
|
integer CCYY, MM, DD;
|
|
integer DayName;
|
|
begin
|
|
DayName := ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
|
|
"Saturday"];
|
|
IntOut(0, CCYY);
|
|
ChOut(0, ^-); IntOut(0, MM/10); IntOut(0, rem(0));
|
|
ChOut(0, ^-); IntOut(0, DD/10); IntOut(0, rem(0));
|
|
Text(0, ": "); Text(0, DayName( DOW( CCYY, MM, DD ) ));
|
|
CrLf(0);
|
|
end;
|
|
|
|
begin \task test cases
|
|
TestDOW( 1800, 1, 6 );
|
|
TestDOW( 1875, 3, 29 );
|
|
TestDOW( 1915, 12, 7 );
|
|
TestDOW( 1970, 12, 23 );
|
|
TestDOW( 2043, 5, 14 );
|
|
TestDOW( 2077, 2, 12 );
|
|
TestDOW( 2101, 4, 2 );
|
|
TestDOW( 2022, 6, 19 )
|
|
end
|