Paste: euler #2

USING: kernel math sequences ;
IN: euler.002

! http://projecteuler.net/index.php?section=problems&id=2

! DESCRIPTION
! -----------

! Each new term in the Fibonacci sequence is generated by adding the previous
! two terms. By starting with 1 and 2, the first 10 terms will be:
!
! 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
!
! Find the sum of all the even-valued terms in the sequence which do not exceed
! four million.

! SOLUTION
! --------

<PRIVATE

: (next-fibs) ( x y -- y x+y )
    swap over + ;

: (max-exceeded?) ( max total fib- fib+ -- max total fib- fib+ bool )
    roll 2dup > >r -roll r> ;

: (+total) ( total fib- fib+ -- newtotal fib- fib+ )
    rot over + -rot ;

: (sum-even-fibs-below) ( max total fib- fib+ -- sum )
    (max-exceeded?) 
    [ 2drop swap drop ] 
    [ 
        dup even?  [ (+total) ] [ ] if 
        (next-fibs) (sum-even-fibs-below)
    ]
    if ;

PRIVATE>

: sum-even-fibs-below ( max -- sum )
    0 0 1 (sum-even-fibs-below) ;

: euler002 ( -- answer )
    4000000 sum-even-fibs-below ;

MAIN: euler002 

Annotation: take 2

<PRIVATE

: next-fibs ( x y -- y x+y )
    swap over + ;

: max-exceeded? ( fib+ max -- bool )
    > ;

: ?retotal ( total fib- fib+ -- retotal fib- fib+ )
    dup even? [ [ swap drop + ] 2keep ] [ ] if ;

: (sum-even-fibs-below) ( partial fib- fib+ max -- total )
    2dup max-exceeded?
    [ 3drop ] 
    [ [ ?retotal next-fibs ] dip (sum-even-fibs-below) ]
    if ;

PRIVATE>

: sum-even-fibs-below ( max -- sum )
    [ 0 0 1 ] dip (sum-even-fibs-below) ;

: euler002 ( -- answer )
    4000000 sum-even-fibs-below ;

Annotation: final?

USING: kernel math sequences ;

IN: euler.002

<PRIVATE

: next-fibs ( x y -- y x+y )
    tuck + ;

: ?retotal ( total fib- fib+ -- retotal fib- fib+ )
    dup even? [ [ nip + ] 2keep ] when ;

: (sum-even-fibs-below) ( partial fib- fib+ max -- total )
    2dup >
    [ 3drop ] 
    [ [ ?retotal next-fibs ] dip (sum-even-fibs-below) ]
    if ;

PRIVATE>

: sum-even-fibs-below ( max -- sum )
    [ 0 0 1 ] dip (sum-even-fibs-below) ;

: euler002 ( -- answer )
    4000000 sum-even-fibs-below ;

MAIN: euler002 

New Annotation