extra/benchmark/partial-sums/partial-sums.factor

   1 USING: math math.functions kernel sequences io io.styles
   2 prettyprint words hints ;
   3 IN: benchmark.partial-sums
   4
   5 : summing ( n quot -- y )
   6     [ >float ] swap [ + ] 3compose
   7     0.0 -rot 1 -rot (each-integer) ; inline
   8
   9 : 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing ;
  10
  11 HINTS: 2/3^k fixnum ;
  12
  13 : k^-0.5 ( n -- y ) [ -0.5 ^ ] summing ;
  14
  15 HINTS: k^-0.5 fixnum ;
  16
  17 : 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing ;
  18
  19 HINTS: 1/k(k+1) fixnum ;
  20
  21 : cube ( x -- y ) dup dup * * ; inline
  22
  23 : flint-hills ( n -- y )
  24     [ dup cube swap sin sq * recip ] summing ;
  25
  26 HINTS: flint-hills fixnum ;
  27
  28 : cookson-hills ( n -- y )
  29     [ dup cube swap cos sq * recip ] summing ;
  30
  31 HINTS: cookson-hills fixnum ;
  32
  33 : harmonic ( n -- y ) [ recip ] summing ;
  34
  35 HINTS: harmonic fixnum ;
  36
  37 : riemann-zeta ( n -- y ) [ sq recip ] summing ;
  38
  39 HINTS: riemann-zeta fixnum ;
  40
  41 : -1^ 2 mod zero? 1 -1 ? ; inline
  42
  43 : alternating-harmonic ( n -- y ) [ dup -1^ swap / ] summing ;
  44
  45 HINTS: alternating-harmonic fixnum ;
  46
  47 : gregory ( n -- y ) [ dup -1^ swap 2 * 1- / ] summing ;
  48
  49 HINTS: gregory fixnum ;
  50
  51 : functions
  52     { 2/3^k k^-0.5 1/k(k+1) flint-hills cookson-hills harmonic riemann-zeta alternating-harmonic gregory } ;
  53
  54 : partial-sums ( n -- )
  55     standard-table-style [
  56         functions [
  57             [ tuck execute pprint-cell pprint-cell ] with-row
  58         ] with each
  59     ] tabular-output ;
  60
  61 : partial-sums-main ( -- ) 2500000 partial-sums ;
  62
  63 MAIN: partial-sums-main