Nachdem Microsoft und Freescale an Silvester ihre geballte Inkompetenz gezeigt haben, blieben Diskussionen zur fehlerfreien Datumsberechnung nicht aus. Dabei ist Datumsberechnung doch so einfach!
Der folgende Code berechnet das Datum des Julianischen und Gregorianischen Kalender (mit Übergang vom 4. Oktober zum 15. Oktober 1582) ohne Tabelle. Zeitnullpunkt, also Tag 0, ist der 1. März im astronomischen Jahr 0 (1 vor Christus), nach Julianischem Kalender.
Im Julianischen Kalender gibt es einen festen Vierjahreszyklus, der durch einen Schalttag abgeschlossen wird (im Februar, dem letzten Monat des römischen Kalenders). Diese vier Jahre haben 1461 Tage. Wenn wir diese Tage durch 365 dividieren, müssen wir nur darauf achten, dass der Wert 4 als Quotient nicht erwünscht ist, sondern 3 heißen soll, und der Rest um den Teiler erhöht wird.
Die Länge der Monate war ursprünglich sehr einfach zu berechnen, da sie abwechselnd 31 und 30 Tage hatten, bis auf den letzten. Augustus hat das etwas durcheinander gebracht, indem er den auf den Juli folgenden August ebenfalls 31 Tage lang gemacht hat. Trotzdem finden wir da eine einfache Formel, da sich das Jahr nun in zwei gleiche, jeweils 153 Tage lange Abschnitte unterteilt, der dann noch Januar und Februar folgen, die ebenfalls dem Muster gehorchen.
Im Gregorianischen Kalender gibt es zu dem 4-Jahres-Zyklus auch einen 100-Jahres-Zyklus mit 36524 Tagen und einen 400-Jahres-Zyklus mit 146097 Tagen. Zudem hat man nicht nur die seit dem Jahr 0 akkumulierten Fehler korrigiert, sondern den Kalender um weitere zwei Tage verschoben, die in den ersten Amtsjahren Augustus durch einen Off-by-one Fehler entstanden sind.
Verwendet man floored division, läuft dieser Kalender auch für negative Zahlen, setzt aber die Fehler des Julianischen Kalenders fort.
\ convert day since 0-3-1 to ymd
\ public domain
: /mod3 ( n1 n2 -- r q )
dup >r /mod dup 4 = IF drop r@ + 3 THEN rdrop ;
: day2dow ( day -- dow ) 2 + 7 mod ;
\ julian calendar
: j-day2ymd ( day -- y m d )
1461 /mod 4 * swap
365 /mod3 rot + swap
31 + 5 153 */mod swap 5 / >r
2 + dup 12 > IF 12 - swap 1+ swap THEN
r> 1+ ;
: (ymd2day) ( y m d -- day year/4 )
1- -rot
2 - dup 0<= IF 12 + swap 1- swap THEN
153 5 */mod swap 0= >r 31 - swap
4 /mod swap 365 * swap >r + + r> swap r> + swap ;
: j-ymd2day ( y m d -- day ) (ymd2day) 1461 * + ;
\ gregorian calendar
1582 10 15 (ymd2day) 1 0 d+ 2Constant gregorian.
1582 10 5 j-ymd2day Constant gregorian
: day2ymd ( day -- y m d )
dup gregorian >= IF
1 - 146097 /mod 400 * swap
36524 /mod3 100 * rot + swap
j-day2ymd 2>r + 2r>
ELSE
1 + j-day2ymd
THEN ;
: ymd2day ( y m d -- day )
(ymd2day)
over 1+ over gregorian. d< 0= IF
25 /mod swap 1461 * swap
4 /mod swap 36524 * swap
146097 * + + + 2 +
ELSE
1461 * +
THEN ;
[defined] t{ [defined] cov% and [IF]
t{ 0 3 1 ymd2day dup day2dow -> 0 1 }t cov% cr
t{ 1582 10 15 ymd2day 1- day2ymd -> 1582 10 4 }t cov% cr
t{ 1400 3 1 ymd2day 1- day2ymd -> 1400 2 29 }t cov% cr
t{ 2018 1 1 ymd2day 1- day2ymd -> 2017 12 31 }t cov% .coverage
\ the tests up to here are sufficient for a full code coverage.
\ they are not sufficient to ensure functionality.
t{ 1900 3 1 ymd2day 1- day2ymd -> 1900 2 28 }t cov% cr
t{ 1582 10 4 ymd2day 1+ day2ymd -> 1582 10 15 }t cov% cr
13 1 [DO] t{ 2018 [I] 13 ymd2day day2ymd -> 2018 [I] 13 }t [LOOP] cov% cr
32 1 [DO] t{ 2018 12 [I] ymd2day day2ymd -> 2018 12 [I] }t [LOOP] cov% cr
t{ 2018 2 1 ymd2day 1- day2ymd -> 2018 1 31 }t cov% cr
t{ 2018 3 1 ymd2day 1- day2ymd -> 2018 2 28 }t cov% cr
t{ 2018 4 1 ymd2day 1- day2ymd -> 2018 3 31 }t cov% cr
t{ 2018 5 1 ymd2day 1- day2ymd -> 2018 4 30 }t cov% cr
t{ 2018 6 1 ymd2day 1- day2ymd -> 2018 5 31 }t cov% cr
t{ 2018 7 1 ymd2day 1- day2ymd -> 2018 6 30 }t cov% cr
t{ 2018 8 1 ymd2day 1- day2ymd -> 2018 7 31 }t cov% cr
t{ 2018 9 1 ymd2day 1- day2ymd -> 2018 8 31 }t cov% cr
t{ 2018 10 1 ymd2day 1- day2ymd -> 2018 9 30 }t cov% cr
t{ 2018 11 1 ymd2day 1- day2ymd -> 2018 10 31 }t cov% cr
t{ 2018 12 1 ymd2day 1- day2ymd -> 2018 11 30 }t cov% cr
2100 1904 [DO] t{ [I] 3 1 ymd2day 1- day2ymd -> [I] 2 29 }t 4 [+LOOP]
2000 1700 [DO] t{ [I] 3 1 ymd2day 1- day2ymd -> [I] 2 28 }t 100 [+LOOP] cov% cr
1620 1560 [DO] t{ [I] 1 3 ymd2day day2ymd -> [I] 1 3 }t [LOOP] cov% cr
7 0 [DO] t{ 1896 [I] + 12 13 ymd2day day2dow -> [I] }t [lOOP] cov% cr
2000 1 1 ymd2day 1461 bounds [DO] t{ [I] day2ymd ymd2day -> [I] }t [LOOP] cov% cr
1580 1 1 ymd2day 1461 bounds [DO] t{ [I] day2ymd ymd2day -> [I] }t [LOOP] cov% cr
.coverage
#ERRORS @ [IF] error-color attr! ." had " #ERRORS ? ." errors"
[ELSE] info-color attr! ." passed successful" [THEN]
default-color attr! cr cov% cr
[THEN]