examples:daymonthyear
Unterschiede
Hier werden die Unterschiede zwischen zwei Versionen angezeigt.
Beide Seiten der vorigen RevisionVorhergehende ÜberarbeitungNächste Überarbeitung | Vorhergehende Überarbeitung | ||
examples:daymonthyear [2018-12-13 23:05] – bernd | examples:daymonthyear [2018-12-14 23:54] (aktuell) – bernd | ||
---|---|---|---|
Zeile 15: | Zeile 15: | ||
<code Forth> | <code Forth> | ||
\ convert day since 0-3-1 to ymd | \ convert day since 0-3-1 to ymd | ||
+ | \ public domain | ||
+ | |||
: /mod3 ( n1 n2 -- r q ) | : /mod3 ( n1 n2 -- r q ) | ||
dup >r /mod dup 4 = IF drop r@ + 3 THEN rdrop ; | dup >r /mod dup 4 = IF drop r@ + 3 THEN rdrop ; | ||
- | + | ||
- | : day2dow ( day -- dow ) | + | : day2dow ( day -- dow ) 2 + 7 mod ; |
- | | + | |
\ julian calendar | \ julian calendar | ||
Zeile 27: | Zeile 27: | ||
1461 /mod 4 * swap | 1461 /mod 4 * swap | ||
365 /mod3 rot + swap | 365 /mod3 rot + swap | ||
- | 31 + 5 153 */mod swap 5 / | + | 31 + 5 153 */mod swap 5 / >r |
- | | + | |
r> 1+ ; | r> 1+ ; | ||
- | + | ||
- | : (ymd2day) ( y m d -- day year/4 ) 1- -rot | + | : (ymd2day) ( y m d -- day year/4 ) |
+ | | ||
2 - dup 0<= IF 12 + swap 1- swap THEN | 2 - dup 0<= IF 12 + swap 1- swap THEN | ||
153 5 */mod swap 0= >r 31 - swap | 153 5 */mod swap 0= >r 31 - swap | ||
4 /mod swap 365 * swap >r + + r> swap r> + swap ; | 4 /mod swap 365 * swap >r + + r> swap r> + swap ; | ||
- | + | ||
- | : j-ymd2day ( y m d -- day ) (ymd2day) | + | : j-ymd2day ( y m d -- day ) (ymd2day) 1461 * + ; |
- | | + | |
\ gregorian calendar | \ gregorian calendar | ||
- | + | ||
- | 1582 10 15 (ymd2day) 2Constant gregorian. | + | 1582 10 15 (ymd2day) |
1582 10 5 j-ymd2day Constant gregorian | 1582 10 5 j-ymd2day Constant gregorian | ||
- | + | ||
- | : day2ymd ( day -- y m d ) dup gregorian >= IF | + | : day2ymd ( day -- y m d ) |
+ | | ||
1 - 146097 /mod 400 * swap | 1 - 146097 /mod 400 * swap | ||
36524 /mod3 100 * rot + swap | 36524 /mod3 100 * rot + swap | ||
Zeile 51: | Zeile 52: | ||
1 + j-day2ymd | 1 + j-day2ymd | ||
THEN ; | THEN ; | ||
- | + | ||
- | : ymd2day ( y m d -- day ) (ymd2day) | + | : ymd2day ( y m d -- day ) |
- | | + | |
+ | | ||
25 /mod swap 1461 * swap | 25 /mod swap 1461 * swap | ||
4 /mod swap 36524 * swap | 4 /mod swap 36524 * swap | ||
Zeile 60: | Zeile 62: | ||
1461 * + | 1461 * + | ||
THEN ; | 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] | ||
+ | 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] | ||
+ | default-color attr! cr cov% cr | ||
+ | [THEN] | ||
</ | </ |
examples/daymonthyear.1544738758.txt.gz · Zuletzt geändert: 2018-12-13 23:05 von bernd