Welcome to the Parallax Discussion Forums, sign-up to participate.

# Date Arithmetic

Posts: 164
edited 2020-05-05 - 05:47:56
Date arithmetic anyone? Don't know if this has been done before in Forth or Tachyon. If so I have flung a lot of sweat reinventing the wheel. I thought I would like to have functions DATE+ and DDAYS like the ones on my Hp-48's. I thought it would be simple. Big laugh. Anyway it passes my test. If anyone is interested you are welcome to use it but you should test it first. It has passed my tests but I might have missed something. If you find something to improve I would like to know about it.
```--- Version 0.4

FORGET daymo
TABLE daymo
0 || 31 || 59 || 90 || 120 || 151 || 181 || 212 || 243 || 273 || 304 || 334 || 365 ||

: DOM1           ( mm -- dom1 )  --- dom1 - 1st day of month
1- daymo SWAP 2 * + W@  --- fetch first day of month ( base 0 )
;

: SYSDAY      ( yymmdd -- sysday ) --- 20010101 subtracted from yymmdd,
---   sysday = number of days since 20010101 (Jan 01, 2001) base 0.
HMS -ROT        --- ( yymmdd -- yy dd mm )
3RD 4 MOD       --- (  -- yy dd mm lyf )  lyf = 1 if leap year
OVER DOM1 1-    --- (  -- yy dd mm lyf Zdom ) dom1 - 1 = Zdom, Zeroth day of month
ROT 2 >         --- (  -- yy dd lyf Zdom ldf ) ldf = 1 if March or later
ROT NOT         --- (  -- yy dd Zdom ldf lyf )
AND NOT         --- (  -- yy dd Zdom lda ) lda = leap day addition if any
+ + 1+          --- (  -- yy doy ) doy = day of year (base 0) with leap adjustment, 1+ restores Zdom offset
SWAP 1-         --- (  -- doy pyy )     pyy = prev years
DUP 4 /         --- (  -- doy pyy pld ) pld = how many prev leap days
SWAP 365 * + +  --- (  -- sysday ) # of prev regular days - sum, sysday (see above)
;

: DOY1  ( yy --- doy1 )  --- yy = year, doy1 = first day thereof , totally confirmed.
1- DUP 4 /            --- num of prev leap days, calculation is done with ordinal of previous year
SWAP 365 * +          --- add leap days --> sysday of first doy
;

: YRDOY   ( sysday -- yy doy ) --- true year and doy ( includes leap day )
DUP 365 / 1+ DUP DOY1      --- guess the year and check it out
---       ( sysday 365 / returns the year before the target...therefore 1+ )
3RD SWAP -                 --- sysday - doy1
DUP 0< IF                  --- IF negative result ( means year is +1 )
DROP                     ---   drop result
1- DUP DOY1              ---   decrement year and try again
ROT SWAP -               ---   sysday - doy1 --> good this time
ELSE                       --- ELSE
ROT DROP                 ---   drop sysday
THEN                       --- THEN
;

: DAYMO       ( doy -- mm dd )   --- derive month and day of month from day of year
daymo 22 + FROM -2 BY 12     --- search backward through daymo for 1dom equal to or less than doy
FOR
DUP
I W@
=> IF I LEAVE THEN         --- found it!
NEXT
DUP daymo - 2/ 1+            --- extract mm from search address
-ROT W@ - 1+                 --- subtract doy of first day of month from target doy
;

: DAY>DATE        ( sysday -- yymmdd )       --- sysday to yymmdd
YRDOY                ( sysday -- yy doy )
OVER 4 MOD 0 > NOT   ( -- yy doy lyf )      --- leap year?
OVER 59 >            ( -- yy doy lyf ldf )  --- after leap day if any?
AND +                ( -- yy doy )          --- combine flags and use result to increment doy or not
DAYMO                ( -- yy mm dd )        ---
4TH 59 =             ( -- yy mm dd lyf )    ---
4TH 4 MOD NOT AND    ( -- yy mm dd ldsf )   --- ldsf = ld substitution flag
IF                   ( -- yy mm dd )        --- if ld sensed
2DROP 2 29         ( -- yy mm' dd' )      ---   leap day substituted
THEN                 ( -- )                     --- then
SWAP 100 * +         ( -- yy mmdd )         --- compile yymmdd
SWAP 10000 * +       ( -- yymmdd )
SWAP DROP            ( -- yymmdd )
;

: DOW   ( sysday -- dow )
1+ 7 MOD
;

: DATE+  ( yymmdd n -- yymmdd + n )
SWAP SYSDAY
+ DAY>DATE
;

: DDAYS  ( yymmdd yymmdd' -- ddays )  --- subtract yymmdd' from yymmdd --> days between two dates
SYSDAY SWAP SYSDAY SWAP -
;
```