]> gitweb.factorcode.org Git - factor.git/commitdiff
Improve project-euler.150
authorEric Mertens <emertens@gmail.com>
Wed, 16 Apr 2008 17:30:03 +0000 (10:30 -0700)
committerEric Mertens <emertens@gmail.com>
Wed, 16 Apr 2008 17:30:03 +0000 (10:30 -0700)
extra/project-euler/150/150.factor

index 3bd145d53ccecaddb9037bc5455aaa73e2f5a876..5b22a1b9f625aeb707b2a1f44626022d7f049439 100644 (file)
@@ -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
 
-: next-t ( t -- t' )
-    615949 * 797807 + 1 20 shift rem ; inline
-
-: next-s ( t -- s )
-    1 19 shift - ; inline
-
-: generate ( -- seq )
-    0 500500 [ drop next-t dup next-s ] map nip ;
+<PRIVATE
 
-: start-index ( i -- n )
-    dup 1- * 2/ ; inline
+! sequence helper functions
 
 : partial-sums ( seq -- seq )
     0 [ + ] accumulate swap suffix ; inline
 
-: as-triangle ( i seq -- slices )
-    swap [1,b] [ [ start-index dup ] keep + rot <slice> ] with map ;
+: generate ( n quot -- seq )
+    [ drop ] swap compose map ; inline
+
+: map-infimum ( seq quot -- min )
+    [ min ] compose 0 swap reduce ; inline
+
+
+! triangle generator functions
 
-: sums-triangle ( -- seqs )
-    1000 generate as-triangle [ partial-sums ] map ;
+: next ( t -- new-t s )
+    615949 * 797807 + 1 20 shift mod dup 1 19 shift - ; inline
 
-SYMBOL: best
+: sums-triangle ( -- seq )
+    0 1000 [ 1+ [ next ] generate partial-sums ] map nip ;
 
-: check-best ( i -- )
-    best [ min ] change ; inline
+PRIVATE>
 
 :: (euler150) ( m -- n )
-    [ [let | table [ sums-triangle ] |
-        0 best set
+    [let | table [ sums-triangle ] |
         m [| x |
-            x 1+ [| y | 
-                1000 x - [| z |
+            x 1+ [| y |
+                m x - [| z |
                     x z + table nth
-                    [ y z + 1+ swap nth ] [ y swap nth ] bi -
-                ] map partial-sums infimum check-best
-            ] each
-        ] each
-      ]
-    best get ] with-scope ;
+                    [ y z + 1+ swap nth ]
+                    [ y        swap nth ] bi -
+                ] map partial-sums infimum
+            ] map-infimum
+        ] map-infimum
+    ] ;
 
 : euler150 ( -- n )
     1000 (euler150) ;