steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Minor tweak to project-euler

db4
Slava Pestov 2008-04-17 12:22:04 -05:00
parent 53c8299576
commit 625d4037fe
1 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/project-euler/150/150.factor
View File

@ -1,15 +1,21 @@
! Copyright (c) 2008 Eric Mertens ! Copyright (c) 2008 Eric Mertens
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences locals ; USING: kernel math sequences sequences.private locals hints ;
IN: project-euler.150 IN: project-euler.150
<PRIVATE <PRIVATE
! sequence helper functions ! sequence helper functions
: partial-sums ( seq -- seq ) : partial-sums ( seq -- sums )
0 [ + ] accumulate swap suffix ; inline 0 [ + ] accumulate swap suffix ; inline
: (partial-sum-infimum) ( inf sum elt -- inf sum )
+ [ min ] keep ; inline
: partial-sum-infimum ( seq -- seq )
0 0 rot [ (partial-sum-infimum) ] each drop ; inline
: generate ( n quot -- seq ) : generate ( n quot -- seq )
[ drop ] swap compose map ; inline [ drop ] swap compose map ; inline
@ -20,25 +26,27 @@ IN: project-euler.150
! triangle generator functions ! triangle generator functions
: next ( t -- new-t s ) : next ( t -- new-t s )
615949 * 797807 + 1 20 shift mod dup 1 19 shift - ; inline 615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
: sums-triangle ( -- seq ) : sums-triangle ( -- seq )
0 1000 [ 1+ [ next ] generate partial-sums ] map nip ; 0 1000 [ 1+ [ next ] generate partial-sums ] map nip ;
PRIVATE> PRIVATE> USING: arrays kernel.private ;
:: (euler150) ( m -- n ) :: (euler150) ( m -- n )
[let | table [ sums-triangle ] | [let | table [ sums-triangle ] |
m [| x | m [| x |
x 1+ [| y | x 1+ [| y |
m x - [| z | m x - [| z |
x z + table nth x z + table nth-unsafe
[ y z + 1+ swap nth ] [ y z + 1+ swap nth-unsafe ]
[ y swap nth ] bi - [ y swap nth-unsafe ] bi -
] map partial-sums infimum ] map partial-sum-infimum
] map-infimum ] map-infimum
] map-infimum ] map-infimum
] ; ] ;
HINTS: (euler150) fixnum ;
: euler150 ( -- n ) : euler150 ( -- n )
1000 (euler150) ; 1000 (euler150) ;