From a25c7e1842161a8ed42407f8d3ef589a35e8546c Mon Sep 17 00:00:00 2001
From: Eric Mertens <emertens@gmail.com>
Date: Wed, 16 Apr 2008 10:30:03 -0700
Subject: [PATCH] Improve project-euler.150

---
 extra/project-euler/150/150.factor | 56 ++++++++++++++----------------
 1 file changed, 27 insertions(+), 29 deletions(-)

diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor
index 3bd145d53c..5b22a1b9f6 100644
--- a/extra/project-euler/150/150.factor
+++ b/extra/project-euler/150/150.factor
@@ -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
+<PRIVATE
 
-: next-s ( t -- s )
-    1 19 shift - ; inline
-
-: generate ( -- seq )
-    0 500500 [ drop next-t dup next-s ] map nip ;
-
-: 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
 
-: sums-triangle ( -- seqs )
-    1000 generate as-triangle [ partial-sums ] map ;
+: map-infimum ( seq quot -- min )
+    [ min ] compose 0 swap reduce ; inline
 
-SYMBOL: best
 
-: check-best ( i -- )
-    best [ min ] change ; inline
+! triangle generator functions
+
+: 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 )
-    [ [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) ;