## ~pfm/forth-kata

aa1c4789ea8eebb18de6c89717847d6542543fb9 — Piotr F. Mieszkowski 2 years ago
```Zeller's congruence in Forth

This is a Forth kata, written because there's no easy way to tell which
day of week a given date is.  Hopefully it's the first in a series.
```
```1 files changed, 65 insertions(+), 0 deletions(-)

A zelcon.fs
```
`A  => zelcon.fs +65 -0`
```@@ 1,65 @@
+\ zelcon.fs --- Zeller's congruence
+
+: year-component ( year - K-based-part )
+    dup 4 / + ;
+
+: century-component ( )
+    dup -2 * swap 4 / + ;
+
+: year-and-century ( year - 2-digit-year century )
+    100 /mod ;
+
+: year-components ( year - year-component )
+    year-and-century
+    century-component swap
+    year-component + ;
+
+: month-component ( month - )
+    1 + 13 * 5 / ;
+
+\ Day is kept unchanged.
+: day ( day - day ) ;
+
+\ Treat January as 13th month of previous year.  In other words
+\ 2000-01-01 is 1999-13-01.
+: do-shift ( month year - month' year' )
+    1 - swap
+    12 + swap ;
+
+: shift? ( month year - month' year' )
+    over 3 < if do-shift then ;
+
+: zellers-congruence ( day month year - dayofweek )
+    shift?
+    year-components swap
+    month-component + swap
+    day +
+    7 mod ;
+
+: z-to-iso-day-of-week
+    5 + 7 mod 1+ ;
+
+: day-of-week ( day month year - day-of-week )
+    zellers-congruence
+    z-to-iso-day-of-week ;
+
+\ Just a word to compare result against expected value and give a
+\ useful message.
+: equal?
+    2dup <>
+    if ." Expected " . ." but got " .
+    else 2drop ." OK"
+    then cr ;
+
+
+: test
+    \ Two examples taken from Wikipedia article:
+    1 1 2000 zellers-congruence 0 equal?
+    1 3 2000 zellers-congruence 4 equal?
+    \ Verified with a wall calendar:
+    1 2 2022 day-of-week 2 equal?	\ 2022-02-01 = Tuesday
+    1 3 2022 day-of-week 2 equal?	\ 2022-03-31 = Thursday
+    1 5 2022 day-of-week 7 equal? ;	\ 2022-05-01 = Sunday
+
+test
+bye

```