USING: arrays io kernel make math math.functions math.parser namespaces sequences ; IN: shootout-pidigits ! A straightforward (and very slow) translation of the algorithm in the paper ! J. Gibbons: Unbounded Spigot Algorithms for the Digits of Pi. ! See http://shootout.alioth.debian.org/u64q/benchmark.php?test=pidigits CONSTANT: line-length 10 : unit ( -- z ) { 1 0 0 1 } ; : lifts ( k -- z ) dup 2 * 1+ dup 2 * 0 rot 4array ; ! extr computes (q*x+r)/(s*x+t), where z = { q r s t }. : extr ( z x -- y ) [ 2 cut-slice ] dip [ over first * swap second + ] curry bi@ / ; ! comp computes { q*u+r*w q*v+r*x s*u+t*w s*v+t*x }, ! where z1 = { q r s t } and z2 = { u v w x }. : comp-1 ( z1 z2 i-array -- n ) dup second rot nth -rot first swap nth * ; : comp ( z1 z2 -- z3 ) { { 0 0 1 2 } { 0 1 1 3 } { 2 0 3 2 } { 2 1 3 3 } } [ [ 2dup ] dip 2 cut-slice [ comp-1 ] dip swap [ comp-1 ] dip + ] with with map ; : prod ( z n -- z' ) 10 swap -10 * 0 1 4array swap comp ; : next-safe? ( z -- n/f ) [ 3 extr floor ] [ 4 extr floor ] bi over = [ drop f ] unless ; : pi-stream ( z k digits -- ) [ rot dup next-safe? dup [ dup , prod -rot 1- ] [ drop rot [ lifts comp ] keep 1+ rot ] if dup 0 > ] loop 3drop ; : pidigit-array ( n -- array ) unit 1 rot [ pi-stream ] { } make ; : print-running-total ( n -- ) "\t:" write number>string print ; : print-last-line ( n -- ) dup line-length mod dup 0 = [ 2drop ] [ line-length swap - [ " " write ] times print-running-total ] if ; : print-pidigits ( n -- ) dup pidigit-array [ swap number>string write 1+ dup line-length mod 0 = [ print-running-total ] [ drop ] if ] each-index print-last-line ;