\ Ramanujan's Taxi

\ print integer solutions to the equation I^3+J^3 = K^3+L^3

\ usage: gforth -e "include taxi.fs 9000 taxi bye"
\ to print all solutions, where I, J, K, L < 9000

\ basically the same algorithm as in
\ <https://www.complang.tuwien.ac.at/forth/programs/taxi.fs>, but this
\ time with a custom hash table.
\
\ for more information on the problem read Vierte Dimension 3+4/2007 or
\ http://www.durangobill.com/Ramanujan.html

: log2 ( n1 -- n2 )
    -1 begin
        over while
            swap 1 rshift swap 1+
    repeat
    nip ;

0 value htable
0 value hshift
$64d9e8f03da92383 constant hmultiplier
variable solutions 0 solutions !

: hfunc ( n -- w )
    hmultiplier * hshift rshift ;

0
 field: tsum
 2 cells +field tpair
 field: tcount
constant tentry

: hinit ( n -- ) \ initialize a hash table larger than n
    log2 1+ ( n1 )
    8 cells over - to hshift
    1 swap lshift
    \ assert( dup -1 hshift rshift 1+ = )
    100 + tentry * dup allocate throw to htable
    htable swap erase ;

: hlookup ( n -- addr f )
    \ if f is true, entry is found and addr is its address.  Otherwise
    \ addr is the address of a free entry for n.
    dup hfunc tentry * htable + begin ( n addr )
        dup tsum @ 0= if nip false exit then
        2dup tsum @ = if nip true exit then
        tentry +
    again ;

: cubed ( n1 -- n2 )
    dup dup * * ;

: insert-sum ( n1 n2 sum addr -- )
    >r
    r@ tsum !
    r> tpair 2! ;

: .sum ( n -- )
    12 u.r ;

: .pair ( n1 n2 -- )
    4 u.r ." ^3 + " 4 u.r ." ^3" ;

: found-solution ( n1 n2 sum addr -- )
    cr >r
    r@ tcount @ if ( n1 n2 sum )
        ." Another solution for " .sum ." : "
    else
        .sum ."  = " r@ tpair 2@ .pair ."  = "
        1 solutions +!
    then
    .pair
    1 r> tcount +! ;

: check-taxi ( n1 n2 -- )
    over cubed over cubed + ( n1 n2 sum )
    dup hlookup if ( n1 n2 sum addr )
        found-solution
    else
        insert-sum
    then ;

: taxi ( n -- )
    dup dup * 3 4 */ hinit
    1 ?do
        i 1 ?do
            i j check-taxi
        loop
    loop ;