Improve project-euler.150
parent
3483317cfb
commit
a25c7e1842
|
@ -1,46 +1,44 @@
|
||||||
USING: kernel math math.ranges math.parser sequences io locals namespaces ;
|
! Copyright (c) 2008 Eric Mertens
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: kernel math sequences locals ;
|
||||||
IN: project-euler.150
|
IN: project-euler.150
|
||||||
|
|
||||||
: next-t ( t -- t' )
|
<PRIVATE
|
||||||
615949 * 797807 + 1 20 shift rem ; inline
|
|
||||||
|
|
||||||
: next-s ( t -- s )
|
! sequence helper functions
|
||||||
1 19 shift - ; inline
|
|
||||||
|
|
||||||
: generate ( -- seq )
|
|
||||||
0 500500 [ drop next-t dup next-s ] map nip ;
|
|
||||||
|
|
||||||
: start-index ( i -- n )
|
|
||||||
dup 1- * 2/ ; inline
|
|
||||||
|
|
||||||
: partial-sums ( seq -- seq )
|
: partial-sums ( seq -- seq )
|
||||||
0 [ + ] accumulate swap suffix ; inline
|
0 [ + ] accumulate swap suffix ; inline
|
||||||
|
|
||||||
: as-triangle ( i seq -- slices )
|
: generate ( n quot -- seq )
|
||||||
swap [1,b] [ [ start-index dup ] keep + rot <slice> ] with map ;
|
[ drop ] swap compose map ; inline
|
||||||
|
|
||||||
: sums-triangle ( -- seqs )
|
: map-infimum ( seq quot -- min )
|
||||||
1000 generate as-triangle [ partial-sums ] map ;
|
[ min ] compose 0 swap reduce ; inline
|
||||||
|
|
||||||
SYMBOL: best
|
|
||||||
|
|
||||||
: check-best ( i -- )
|
! triangle generator functions
|
||||||
best [ min ] change ; inline
|
|
||||||
|
: next ( t -- new-t s )
|
||||||
|
615949 * 797807 + 1 20 shift mod dup 1 19 shift - ; inline
|
||||||
|
|
||||||
|
: sums-triangle ( -- seq )
|
||||||
|
0 1000 [ 1+ [ next ] generate partial-sums ] map nip ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
:: (euler150) ( m -- n )
|
:: (euler150) ( m -- n )
|
||||||
[ [let | table [ sums-triangle ] |
|
[let | table [ sums-triangle ] |
|
||||||
0 best set
|
|
||||||
m [| x |
|
m [| x |
|
||||||
x 1+ [| y |
|
x 1+ [| y |
|
||||||
1000 x - [| z |
|
m x - [| z |
|
||||||
x z + table nth
|
x z + table nth
|
||||||
[ y z + 1+ swap nth ] [ y swap nth ] bi -
|
[ y z + 1+ swap nth ]
|
||||||
] map partial-sums infimum check-best
|
[ y swap nth ] bi -
|
||||||
] each
|
] map partial-sums infimum
|
||||||
] each
|
] map-infimum
|
||||||
]
|
] map-infimum
|
||||||
best get ] with-scope ;
|
] ;
|
||||||
|
|
||||||
: euler150 ( -- n )
|
: euler150 ( -- n )
|
||||||
1000 (euler150) ;
|
1000 (euler150) ;
|
||||||
|
|
Loading…
Reference in New Issue