Forth-eV Wiki

Benutzer-Werkzeuge

Webseiten-Werkzeuge

Sie befinden sich hier: Forth Wiki » Examples in Forth » Datumsberechnung in Forth
Zuletzt angesehen:
examples:daymonthyear

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

Link zu dieser Vergleichsansicht

Nächste Überarbeitung		Vorhergehende Überarbeitung
examples:daymonthyear [2013-06-06 21:26] – Externe Bearbeitung 127.0.0.1examples: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 ; 
-    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 2 + dup 12 > IF  12 - swap 1+ swap  THEN+    2 + dup 12 > IF  12 - swap 1+ swap  THEN
     r> 1+ ;     r> 1+ ;
- +  
-: (ymd2day) ( y m d -- day year/4 )  1- -rot+: (ymd2day) ( y m d -- day year/4 ) 
 +    1- -rot
     2 - dup 0<= IF  12 + swap 1- swap  THEN     2 - dup 0<= IF  12 + swap 1- swap  THEN
-    153 5 */ 31 - swap +    153 5 */mod swap 0= >r 31 - swap 
-    4 /mod swap 365 * swap >r + + r> ; +    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 * + ; 
-    1461 * + ; + 
 \ gregorian calendar \ gregorian calendar
- +  
-1582 10 15 (ymd2day) 2Constant gregorian.+1582 10 15 (ymd2day) 1 0 d+ 2Constant gregorian.
 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 ) 
 +    dup gregorian >= IF
  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 ) 
-    2dup gregorian. d< 0= IF+    (ymd2day) 
 +    over 1+ over gregorian. d< 0= IF
  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]    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]
 </code> </code>
examples/daymonthyear.1370546810.txt.gz · Zuletzt geändert: 2013-06-06 21:26 von 127.0.0.1