From 9d063158098696097b0622d4c5f776a2567e9d73 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 3 Nov 2008 20:14:37 -0500
Subject: [PATCH] Clean up of common Project Euler code

---
 extra/project-euler/common/common.factor | 18 ++++++++++--------
 extra/project-euler/project-euler.factor | 12 ++++++------
 2 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index d87aecb6a8..d3263bbc1e 100644
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -15,7 +15,7 @@ IN: project-euler.common
 ! log10 - #25, #134
 ! max-path - #18, #67
 ! nth-triangle - #12, #42
-! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56
+! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92
 ! palindrome? - #4, #36, #55
 ! pandigital? - #32, #38
 ! pentagonal? - #44, #45
@@ -25,8 +25,8 @@ IN: project-euler.common
 ! [uad]-transform - #39, #75
 
 
-: nth-pair ( n seq -- nth next )
-    2dup [ 1+ ] dip [ nth ] 2bi@ ;
+: nth-pair ( seq n -- nth next )
+    tail-slice first2 ;
 
 : perfect-square? ( n -- ? )
     dup sqrt mod zero? ;
@@ -34,7 +34,7 @@ IN: project-euler.common
 <PRIVATE
 
 : max-children ( seq -- seq )
-    [ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
+    [ dup length 1- [ nth-pair max , ] with each ] { } make ;
 
 ! Propagate one row into the upper one
 : propagate ( bottom top -- newtop )
@@ -84,8 +84,9 @@ PRIVATE>
 
 ! Not strictly needed, but it is nice to be able to dump the triangle after the
 ! propagation
-: propagate-all ( triangle -- newtriangle )
-    reverse [ first dup ] keep rest [ propagate dup ] map nip reverse swap suffix ;
+: propagate-all ( triangle -- new-triangle )
+    reverse [ first dup ] [ rest ] bi
+    [ propagate dup ] map nip reverse swap suffix ;
 
 : sum-divisors ( n -- sum )
     dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
@@ -108,8 +109,9 @@ PRIVATE>
 
 ! Optimized brute-force, is often faster than prime factorization
 : tau* ( m -- n )
-    factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
-    dup sqrt >fixnum [1,b] [
+    factor-2s dup [ 1+ ]
+    [ perfect-square? -1 0 ? ]
+    [ dup sqrt >fixnum [1,b] ] tri* [
         dupd mod zero? [ [ 2 + ] dip ] when
     ] each drop * ;
 
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 9dfaad0e7b..5192e23a27 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -14,12 +14,12 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
     project-euler.045 project-euler.046 project-euler.047 project-euler.048
-    project-euler.052 project-euler.053 project-euler.056 project-euler.059
-    project-euler.067 project-euler.075 project-euler.079 project-euler.092
-    project-euler.097 project-euler.100 project-euler.116 project-euler.117
-    project-euler.134 project-euler.148 project-euler.150 project-euler.151
-    project-euler.164 project-euler.169 project-euler.173 project-euler.175
-    project-euler.186 project-euler.190 ;
+    project-euler.052 project-euler.053 project-euler.055 project-euler.056
+    project-euler.059 project-euler.067 project-euler.075 project-euler.076
+    project-euler.079 project-euler.092 project-euler.097 project-euler.100
+    project-euler.116 project-euler.117 project-euler.134 project-euler.148
+    project-euler.150 project-euler.151 project-euler.164 project-euler.169
+    project-euler.173 project-euler.175 project-euler.186 project-euler.190 ;
 IN: project-euler
 
 <PRIVATE