consider the following factor definition:
:: julian-day-number ( $year $month $day -- n )
14 $month - 12 /i :> $a $year 4800 + $a -
:> $y $month 12 $a * + 3 - :> $m $day 153 $m * 2 + 5 /i +
365 $y * + $y 4 /i + $y 100 /i - $y 400 /i + 32045 - ;i translated it directly into k:
ymdjdn:{[year;month;day]
a:_(14-month)%12
Y:(year+4800)-a
m:(month+12*a)-3
:+/(_Y%400;day;_(2+153*m)%5;365*Y;_Y%4;-_Y%100;-32045)}then i notice that m is used only once, so i inline it:
ymdjdn:{[year;month;day]
a:_(14-month)%12
Y:(year+4800)-a
:+/(_Y%400;day;_(2+153*(month+12*a)-3)%5;365*Y;_Y%4;-_Y%100;-32045)}then i notice that all the places that Y is used follow a common form: _Y%x—well, except for Y*365, but i can express division as multiplication by inverse, and i can take the floor of the result of a whole number just as much as a decimal, so indeed they do all follow the form _Y*x:
ymdjdn:{[year;month;day]
a:_(14-month)%12
:+/(+/-1 1 1 1*_0.01 0.0025 0.25 365*(year+4800)-a;day-32045;_(2+153*(month+12*a)-3)%5)}note that i can’t use negative literals because the floor of a negative number increases its absolute value, whereas i want to decrease the absolute value; i must negate after flooring. also, i moved -32045 from <the list over which we sum> next to day just because it’s a bit cleaner.
finally, because it’s k, i can inline a:
ymdjdn:{[year;month;day]:+/(+/-1 1 1 1*_0.01 0.0025 0.25 365*(year+4800)-a;day-32045;_(2+153*(month+12*a:_(14-month)%12)-3)%5)}|
Note
|
this is one line; if it’s displayed as multiple, it’s the asciidoc renderer’s fault. look at the raw text in this asciidoc file. |
when i back-translate this to factor, i can refactor the code even more. i note:
-
dayis used only once. its value is replaced byday-32045, and that value is only used in adding to the other two (the list over which we sum has only 3 items). -
monthis used to computea, then is used once more in a function witha.( month — a )followed by( month a — b ). -
the stuff with
Ytranslates almost verbatim. we’re lucky that we work with exactly 4 floats; this is expressible by simd instructions.
i actually wrote the factor translation before i completely reduced the above, final k definition, so the finished factor version below is a bit different than the above bullets suggest, but it’s pretty nearly the same:
: ymd>jdn ( y m d -- jdn )
[ 14 over - 12 /i
[ - 4800 + float-4{ 0.25 0.0025 365 0.01 } swap v*n vfloor float-4{ 1 1 1 -1 } v* sum ]
[ 12 * + 3 - 153 * 2 + 5 /i ] bi-curry bi*
] dip + + 32045 - >integer ;we can, of course, put such arithmetic as 4800 + in any of many arbitrary places in the definition, just as we can use dup vs keep or over equivalently.
with that done, let’s do the same for the inverse function:
:: julian-day-number>date ( $n -- year month day )
$n 32044 + :> $a 4 $a * 3 + 146097 /i :> $b $a 146097 $b *
4 /i - :> $c 4 $c * 3 + 1461 /i :> $d $c 1461 $d * 4 /i -
:> $e 5 $e * 2 + 153 /i :> $m 100 $b * $d + 4800 - $m 10 /i
+ $m 3 + 12 $m 10 /i * - $e 153 $m * 2 + 5 /i - 1 + ;this scary thing directly translated into k:
jdnymd:{
a:32044+x
b:_(3+4*a)%146097
c:a-_(146097*b)%4
d:_(3+4*c)%1461
e:c-_(1461*d)%4
m:_(2+5*e)%153
:((_m%10)+(d+100*b)-4800; 3+m-12*_m%10; 1+e-_(2+153*m)%5)}the first thing that i did is to track in which expressions which variables are used:
-
ais used only to computeb&c -
cis used only to computed&e -
b,d,e, &mis used in the final line -
mis used at least once in each of the items of the final line’s list. in the list’s middle expression, it’s used twice.
i looked at it awhile, eventually seeing common patterns, which you can see when i expand & pad the code; notice how the computation for b & d, and for c & e, are the same form:
jdnymd:{
a:32044+x
b:_(3+4*a)%146097
c:a-_(146097*b)%4
d:_(3+4*c)%001461
e:c-_(001461*d)%4
m:_(2+5*e)%153
/ f
/ |------------|
:((_m%10)+(d+100*b)-4800 / m d b
3+m-12*_m%10 / m
1+e-_(2+153*m)%5)} / m ei defined f during my later translation into factor; i noticed that b & d were on the stack, but i wanted to combine them into one value so that i’d be managing fewer stack items.
notice that in defining b & c, they both have the same constant 146097. indeed, similarly, both d & e use the constant 1461. this translates nicely into factor combinators:
: jdn>ymd ( jdn -- y m d )
32044 + 146097 1461 [ [ [ 4 * 3 + ] dip /i ] 2keep pick * 4 /i - ] bi-curry@ [ call ] dip call ! q: ( a k -- b c )
! .s: b d e
[ 100 * ] [ + 4800 - ] [ ] tri* ! f e
dup 5 * 2 + 153 /i ! .s: f e m
[ [ 10 /i + ] [ 153 * 2 + 5 /i - 1 + ] bi-curry bi* ] keep
[ ] [ 10 /i 12 * - 3 + ] bi
swap ;this could probably be refactored into a terser form. i’ll do that eventually. for now, the last thing is to improve the k version by using the quotation passed to bi-curry@:
i can’t express bi-curry@ [ call ] dip call in k because it’s too asymmetric and stack-y. it’s the pattern
f(a,k1) -> (b,c)
|
v
(d,e) <- f(c,k2)
where we retain b. i don’t see how i can express this tacitly in k or j. i’d like to not bind the quotation (lambda) to an identifier just to call it twice, but alas. the best that i could manage is:
jdnymd:{
f:{(i;y-_(x*i:_(3+4*y)%x)%4)}
(d;e):f.1461,1_(b;c):f[146097;32044+x] / c is dummy
m:_(2+5*e)%153
:((_m%10)+(d+100*b)-4800
3+m-12*_m%10
1+e-_(2+153*m)%5)}i retain b by binding it inline, then i replace it by 1461, then use "apply" (as it’s called in scheme; it uses a list as an argument vector). c is a dummy because, unlike haskell, we can’t use _ to mean "hole" i.e. "don’t bind". it should be possible to define a version where i make the lambda anonymous and pass it to the "n times" adverb (namely 2{…}/(146097;32044+x)) but i really tried, yet failed. i know that it’s possible, but it’s not going to give better code than the above. such code would also be expressible in factor by using times, since the quotation would be inline and the stack effect would be ( x — x ), since the single argument is just a vector; but as in k, the current factor version is nicer & faster.