Paste: PE 255

Author: Sam
Mode: factor
Date: Mon, 14 Sep 2009 19:18:12
Plain Text | 
USING: kernel math math.functions sequences ;

IN: sr

: digits ( n -- d ) .5 + log10 1 + floor ;

: initial ( n -- x0 ) digits [ 1 - 2 / floor 10^ ] [ odd? 2 7 ? * ] bi >integer ;

: xn ( n xn-1 -- xn ) [ / ceiling ] keep + 2/ ;

: xns ( n -- steps )	[ 0 ] [ initial ] bi [ tuck = not ] [ 2dup xn dup ] produce [ 2drop ] dip ;

Annotation: Another (ugly but complete) version

Author: Sam
Mode: factor
Date: Thu, 17 Sep 2009 17:58:33
Plain Text | 
USING: kernel locals math math.functions math.order math.ranges sequences project-euler.c\
ommon ;

IN: sr

: initial ( n -- x0 ) number-length [ 1 - 2 /i 10^ ] [ odd? 2 7 ? * ] bi ; inline

: xn ( n xn-1 -- xn ) [ [ 1 - + ] keep /i ] keep + 2/ ; inline

: xns ( n x0 -- steps )
    0 swap [ tuck = not ] [ [ 2dup xn ] keep ] V{ } produce-as
    [ 2drop ] dip ; inline

: find-mod ( n off m -- n' )
    [ [ - ] [ /i ] bi* 1 + ] 2keep swap [ * ] [ + ] bi* ; inline

: next-mod1 ( n m -- n' )
    [ dup odd? [ drop 1 ] [ 1 + ] if ] keep 2 * find-mod ; inline

: next-n ( n seq -- n' ) [ next-mod1 ] with map infimum ; inline

: current ( n x0 -- n' length )	dupd xns [ next-n ] [ length ] bi ; inline

:: compute ( high low -- total )
    low initial :> x0
    0 high low
    [| high low |
        low x0 current swap high min :> next
        next low - * +
        high next 2dup >
    ] loop 2drop ; inline

: mean ( pow -- mean ) 10^ [ 10 * ] keep [ compute ] [ - / ] 2bi ;
                                      
: euler255 ( -- n )
    13 mean 10 10^ [ * round ] [ / ] bi >float ;

New Annotation

Summary:
Author:
Mode:
Body: