2008-11-29 04:50:17 -05:00
|
|
|
USING: math math.functions kernel io io.styles
|
|
|
|
|
prettyprint combinators hints fry namespaces ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: benchmark.partial-sums
|
|
|
|
|
|
2008-11-29 04:50:17 -05:00
|
|
|
! Helper words
|
|
|
|
|
: summing-integers ( n quot -- y ) [ 0.0 1 ] 2dip '[ @ + ] (each-integer) ; inline
|
|
|
|
|
: summing-floats ( n quot -- y ) '[ >float @ ] summing-integers ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
: cube ( x -- y ) dup dup * * ; inline
|
2008-11-29 04:50:17 -05:00
|
|
|
: -1^ 2 mod 2 * 1- ; inline
|
|
|
|
|
|
|
|
|
|
! The functions
|
|
|
|
|
: 2/3^k ( n -- y ) [ 2.0 3.0 / swap 1- ^ ] summing-floats ; inline
|
|
|
|
|
: k^-0.5 ( n -- y ) [ -0.5 ^ ] summing-floats ; inline
|
|
|
|
|
: 1/k(k+1) ( n -- y ) [ dup 1+ * recip ] summing-floats ; inline
|
|
|
|
|
: flint-hills ( n -- y ) [ [ cube ] [ sin sq ] bi * recip ] summing-floats ; inline
|
|
|
|
|
: cookson-hills ( n -- y ) [ [ cube ] [ cos sq ] bi * recip ] summing-floats ; inline
|
|
|
|
|
: harmonic ( n -- y ) [ recip ] summing-floats ; inline
|
|
|
|
|
: riemann-zeta ( n -- y ) [ sq recip ] summing-floats ; inline
|
|
|
|
|
: alternating-harmonic ( n -- y ) [ [ -1^ ] keep /f ] summing-integers ; inline
|
|
|
|
|
: gregory ( n -- y ) [ [ -1^ ] [ 2.0 * 1- ] bi / ] summing-integers ; inline
|
|
|
|
|
|
|
|
|
|
: partial-sums ( n -- results )
|
|
|
|
|
[
|
|
|
|
|
{
|
|
|
|
|
[ 2/3^k \ 2/3^k set ]
|
|
|
|
|
[ k^-0.5 \ k^-0.5 set ]
|
|
|
|
|
[ 1/k(k+1) \ 1/k(k+1) set ]
|
|
|
|
|
[ flint-hills \ flint-hills set ]
|
|
|
|
|
[ cookson-hills \ cookson-hills set ]
|
|
|
|
|
[ harmonic \ harmonic set ]
|
|
|
|
|
[ riemann-zeta \ riemann-zeta set ]
|
|
|
|
|
[ alternating-harmonic \ alternating-harmonic set ]
|
|
|
|
|
[ gregory \ gregory set ]
|
|
|
|
|
} cleave
|
|
|
|
|
] { } make-assoc ;
|
|
|
|
|
|
|
|
|
|
HINTS: partial-sums fixnum ;
|
|
|
|
|
|
|
|
|
|
: partial-sums-main ( -- )
|
|
|
|
|
2500001 partial-sums simple-table. ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
|
MAIN: partial-sums-main
|
