Cleanup of all Project Euler solutions thus far

extra/project-euler/002/002.factor

@@ -19,11 +19,15 @@ IN: project-euler.002
 ! SOLUTION
 ! --------
 
-: last2 ( seq -- elt last )
+<PRIVATE
-    2 tail* first2 ;
+
+: (fib-upto) ( seq n limit -- seq )
+    2dup <= [ >r add dup 2 tail* sum r> (fib-upto) ] [ 2drop ] if ;
+
+PRIVATE>
 
 : fib-upto ( n -- seq )
-    { 0 } 1 [ pick dupd < ] [ add dup last2 + ] [ ] while drop nip ;
+    { 0 } 1 rot (fib-upto) ;
 
 : euler002 ( -- answer )
     1000000 fib-upto [ even? ] subset sum ;

extra/project-euler/003/003.factor

@@ -16,13 +16,10 @@ IN: project-euler.003
 ! SOLUTION
 ! --------
 
-: largest-prime-factor ( n -- factor )
-  factors supremum ;
-
 : euler003 ( -- answer )
-  317584931803 largest-prime-factor ;
+    317584931803 factors supremum ;
 
-! [ euler003 ] time
+! [ euler003 ] 100 ave-time
-! 2 ms run / 0 ms GC time
+! 1 ms run / 0 ms GC ave time - 100 trials
 
 MAIN: euler003

extra/project-euler/004/004.factor

@@ -26,14 +26,16 @@ IN: project-euler.004
 
 <PRIVATE
 
+: source-004 ( -- seq )
+    100 999 [a,b] [ 10 mod zero? not ] subset ;
+
 : max-palindrome ( seq -- palindrome )
     natural-sort [ palindrome? ] find-last nip ;
 
 PRIVATE>
 
 : euler004 ( -- answer )
-    100 999 [a,b] [ 10 mod zero? not ] subset dup
+    source-004 dup cartesian-product [ product ] map prune max-palindrome ;
-    cartesian-product [ product ] map prune max-palindrome ;
 
 ! [ euler004 ] 100 ave-time
 ! 1608 ms run / 102 ms GC ave time - 100 trials

extra/project-euler/005/005.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions sequences ;
+USING: math math.functions sequences ;
 IN: project-euler.005
 
 ! http://projecteuler.net/index.php?section=problems&id=5

extra/project-euler/007/007.factor

@@ -18,12 +18,12 @@ IN: project-euler.007
 ! --------
 
 : nth-prime ( n -- n )
-  1 - lprimes lnth ;
+    1- lprimes lnth ;
 
 : euler007 ( -- answer )
     10001 nth-prime ;
 
-! [ euler007 ] time
+! [ euler007 ] 100 ave-time
-! 22 ms run / 0 ms GC time
+! 10 ms run / 0 ms GC ave time - 100 trials
 
 MAIN: euler007

extra/project-euler/008/008.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.parser project-euler.common sequences ;
+USING: math.parser project-euler.common sequences ;
 IN: project-euler.008
 
 ! http://projecteuler.net/index.php?section=problems&id=8

extra/project-euler/009/009.factor

@@ -26,20 +26,18 @@ IN: project-euler.009
 
 : next-pq ( p1 q1 -- p2 q2 )
     ! p > q and both are odd integers
-    dup 1 = [ swap 2 + nip dup 2 - ] [ 2 - ] if ;
+    dup 1 = [ drop 2 + dup ] when 2 - ;
 
 : abc ( p q -- triplet )
     [
         2dup * ,                    ! a = p * q
-        2dup sq swap sq swap - 2 / ,  ! b = (p² - q²) / 2
+        [ sq ] 2apply 2dup - 2 / ,  ! b = (p² - q²) / 2
-        sq swap sq swap + 2 / ,       ! c = (p² + q²) / 2
+        + 2 / ,                     ! c = (p² + q²) / 2
     ] { } make natural-sort ;
 
 : (ptriplet) ( target p q triplet -- target p q )
-    roll dup >r swap sum = r> -roll
+    roll [ swap sum = ] keep -roll
-    [
+    [ next-pq 2dup abc (ptriplet) ] unless ;
-        next-pq 2dup abc (ptriplet)
-    ] unless ;
 
 : ptriplet ( target -- triplet )
    3 1 { 3 4 5 } (ptriplet) abc nip ;

extra/project-euler/010/010.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.primes sequences ;
+USING: math.primes sequences ;
 IN: project-euler.010
 
 ! http://projecteuler.net/index.php?section=problems&id=10

extra/project-euler/012/012.factor

@@ -37,7 +37,7 @@ IN: project-euler.012
     dup 1+ * 2 / ;
 
 : euler012 ( -- answer )
-    2 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
+    8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
 
 ! [ euler012 ] 10 ave-time
 ! 5413 ms run / 1 ms GC ave time - 10 trials

extra/project-euler/013/013.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.parser sequences ;
+USING: math.parser sequences ;
 IN: project-euler.013
 
 ! http://projecteuler.net/index.php?section=problems&id=13

extra/project-euler/014/014.factor

@@ -39,7 +39,7 @@ IN: project-euler.014
     dup even? [ 2 / ] [ 3 * 1+ ] if ;
 
 : longest ( seq seq -- seq )
-    2dup length swap length > [ nip ] [ drop ] if ;
+    2dup [ length ] 2apply > [ drop ] [ nip ] if ;
 
 PRIVATE>
 
@@ -47,7 +47,7 @@ PRIVATE>
     [ [ dup 1 > ] [ dup , next-collatz ] [ ] while , ] { } make ;
 
 : euler014 ( -- answer )
-    1000000 0 [ 1+ collatz longest ] reduce first ;
+    1000000 [1,b] 0 [ collatz longest ] reduce first ;
 
 ! [ euler014 ] time
 ! 52868 ms run / 483 ms GC time
@@ -59,10 +59,7 @@ PRIVATE>
 <PRIVATE
 
 : worth-calculating? ( n -- ? )
-    {
+    { [ dup 1- 3 mod zero? ] [ dup 1- 3 / even? ] } && nip ;
-        [ dup 1- 3 mod zero? ]
-        [ dup 1- 3 / even? ]
-    } && nip ;
 
 PRIVATE>
 
@@ -72,7 +69,7 @@ PRIVATE>
     ] reduce first ;
 
 ! [ euler014a ] 10 ave-time
-! 5109 ms run / 44 ms GC time
+! 4821 ms run / 41 ms GC time
 
 ! TODO: try using memoization
 

extra/project-euler/016/016.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.functions math.parser project-euler.common sequences ;
+USING: math.functions math.parser project-euler.common sequences ;
 IN: project-euler.016
 
 ! http://projecteuler.net/index.php?section=problems&id=16

extra/project-euler/017/017.factor

@@ -1,7 +1,6 @@
-! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
+! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.ranges math.text namespaces sequences
+USING: combinators.lib kernel math.ranges math.text sequences strings ;
-    strings ;
 IN: project-euler.017
 
 ! http://projecteuler.net/index.php?section=problems&id=17
@@ -23,55 +22,10 @@ IN: project-euler.017
 ! SOLUTION
 ! --------
 
-<PRIVATE
-
-: units ( n -- )
-  {
-    "zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"
-    "ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen"
-    "seventeen" "eighteen" "nineteen"
-  } nth % ;
-
-: tenths ( n -- )
-  {
-    f f "twenty" "thirty" "fourty" "fifty" "sixty" "seventy" "eighty" "ninety"
-  } nth % ;
-
-DEFER: make-english
-
-: maybe-add ( n sep -- )
-  over zero? [ 2drop ] [ % make-english ] if ;
-
-: 0-99 ( n -- )
-  dup 20 < [ units ] [ 10 /mod swap tenths "-" maybe-add ] if ;
-
-: 0-999 ( n -- )
-  100 /mod swap
-  dup zero? [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
-
-: make-english ( n -- )
-  1000 /mod swap
-  dup zero? [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
-
-PRIVATE>
-
-: >english ( n -- str )
-  [ make-english ] "" make ;
-
 : euler017 ( -- answer )
-  1000 [1,b] [ >english [ letter? ] subset length ] map sum ;
-
-! [ euler017 ] 100 ave-time
-! 9 ms run / 0 ms GC ave time - 100 trials
-
-
-! ALTERNATE SOLUTIONS
-! -------------------
-
-: euler017a ( -- answer )
     1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
 
 ! [ euler017a ] 100 ave-time
-! 14 ms run / 1 ms GC ave time - 100 trials
+! 14 ms run / 0 ms GC ave time - 100 trials
 
 MAIN: euler017

extra/project-euler/018/018.factor

@@ -50,9 +50,8 @@ IN: project-euler.018
 
 <PRIVATE
 
-: pyramid ( -- seq )
+: source-018 ( -- triangle )
-  {
+    {                              75
-                         75
                                  95  64
                                17  47  82
                              18  35  87  10
@@ -67,22 +66,12 @@ IN: project-euler.018
            91  71  52  38  17  14  91  43  58  50  27  29  48
          63  66  04  68  89  53  67  30  73  16  69  87  40  31
        04  62  98  27  23  09  70  98  73  93  38  53  60  04  23
-  }
+     } 15 [ 1+ cut swap ] map nip ;
-  15 [ 1+ cut swap ] map nip ;
 
 PRIVATE>
 
-! Propagate one row into the upper one
-: propagate ( bottom top -- newtop )
-    [ over 1 tail rot first2 max rot + ] map nip ;
-
-! Not strictly needed, but it is nice to be able to dump the pyramid after
-! the propagation
-: propagate-all ( pyramid -- newpyramid )
-    reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
-
 : euler018 ( -- answer )
-    pyramid propagate-all first first ;
+    source-018 propagate-all first first ;
 
 ! [ euler018 ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials
@@ -91,31 +80,10 @@ PRIVATE>
 ! ALTERNATE SOLUTIONS
 ! -------------------
 
-<PRIVATE
-
-: source-018a ( -- triangle )
-    { { 75 }
-      { 95 64 }
-      { 17 47 82 }
-      { 18 35 87 10 }
-      { 20 04 82 47 65 }
-      { 19 01 23 75 03 34 }
-      { 88 02 77 73 07 63 67 }
-      { 99 65 04 28 06 16 70 92 }
-      { 41 41 26 56 83 40 80 70 33 }
-      { 41 48 72 33 47 32 37 16 94 29 }
-      { 53 71 44 65 25 43 91 52 97 51 14 }
-      { 70 11 33 28 77 73 17 78 39 68 17 57 }
-      { 91 71 52 38 17 14 91 43 58 50 27 29 48 }
-      { 63 66 04 68 89 53 67 30 73 16 69 87 40 31 }
-      { 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 } } ;
-
-PRIVATE>
-
 : euler018a ( -- answer )
-    source-018a max-path ;
+    source-018 max-path ;
 
 ! [ euler018a ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials
 
-MAIN: euler018
+MAIN: euler018a

extra/project-euler/019/019.factor

@@ -30,9 +30,10 @@ IN: project-euler.019
 ! already, as "zeller-congruence ( year month day -- n )" where n is
 ! the day of the week (Sunday is 0).
 
-: euler019 ( -- count )
+: euler019 ( -- answer )
-  1901 2000 [a,b] [ 12 [1,b] [ 1 zeller-congruence ] 1 map-withn ] map concat
+    1901 2000 [a,b] [
-  [ 0 = ] subset length ;
+        12 [1,b] [ 1 zeller-congruence ] 1 map-withn
+    ] map concat [ zero? ] count ;
 
 ! [ euler019 ] 100 ave-time
 ! 1 ms run / 0 ms GC ave time - 100 trials

extra/project-euler/020/020.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.combinatorics math.parser project-euler.common sequences ;
+USING: math.combinatorics math.parser project-euler.common sequences ;
 IN: project-euler.020
 
 ! http://projecteuler.net/index.php?section=problems&id=20

extra/project-euler/022/022.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib io io.files kernel math math.parser namespaces sequences
+USING: io.files kernel math math.parser namespaces sequences sorting splitting
-    sorting splitting strings system vocabs ;
+    strings system vocabs ;
 IN: project-euler.022
 
 ! http://projecteuler.net/index.php?section=problems&id=22
@@ -32,7 +32,7 @@ IN: project-euler.022
     file-contents [ quotable? ] subset "," split ;
 
 : alpha-value ( str -- n )
-    string>digits [ 9 - ] sigma ;
+    [ string>digits sum ] keep length 9 * - ;
 
 : name-scores ( seq -- seq )
     dup length [ 1+ swap alpha-value * ] 2map ;

extra/project-euler/024/024.factor

@@ -27,11 +27,11 @@ IN: project-euler.024
 : (>permutation) ( seq n -- seq )
     [ [ dupd >= [ 1+ ] when ] curry map ] keep add* ;
 
+PRIVATE>
+
 : >permutation ( factoradic -- permutation )
     reverse 1 cut [ (>permutation) ] each ;
 
-PRIVATE>
-
 : factoradic ( k order -- factoradic )
     [ [1,b] [ 2dup mod , /i ] each ] { } make reverse nip ;
 

extra/project-euler/025/025.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.syntax kernel math math.functions math.parser math.ranges memoize
-    sequences ;
+    project-euler.common sequences ;
 IN: project-euler.025
 
 ! http://projecteuler.net/index.php?section=problems&id=25
@@ -39,7 +39,7 @@ IN: project-euler.025
 ! Memoized brute force
 
 MEMO: fib ( m -- n )
-    dup 1 > [ 1 - dup fib swap 1 - fib + ] when ;
+    dup 1 > [ 1- dup fib swap 1- fib + ] when ;
 
 <PRIVATE
 
@@ -67,8 +67,6 @@ PRIVATE>
 
 <PRIVATE
 
-FUNCTION: double log10 ( double x ) ;
-
 : phi ( -- phi )
     5 sqrt 1+ 2 / ;
 

extra/project-euler/067/067.factor

@@ -1,7 +1,6 @@
 ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io io.files kernel math.parser namespaces project-euler.018
+USING: io.files math.parser namespaces project-euler.common sequences splitting ;
-    project-euler.common sequences splitting system vocabs ;
 IN: project-euler.067
 
 ! http://projecteuler.net/index.php?section=problems&id=67
@@ -39,7 +38,7 @@ IN: project-euler.067
 
 : source-067 ( -- seq )
     "extra/project-euler/067/triangle.txt" resource-path
-    <file-reader> lines [ " " split [ string>number ] map ] map ;
+    file-lines [ " " split [ string>number ] map ] map ;
 
 PRIVATE>
 
@@ -57,7 +56,7 @@ PRIVATE>
     source-067 max-path ;
 
 ! [ euler067a ] 100 ave-time
-! 15 ms run / 0 ms GC ave time - 100 trials
+! 14 ms run / 0 ms GC ave time - 100 trials
 
 ! source-067 [ max-path ] curry 100 ave-time
 ! 3 ms run / 0 ms GC ave time - 100 trials

extra/project-euler/134/134.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel lazy-lists math.algebra math math.functions math.primes
-       math.ranges sequences ;
+    math.ranges project-euler.common sequences ;
 IN: project-euler.134
 
 ! http://projecteuler.net/index.php?section=problems&id=134
@@ -9,23 +9,26 @@ IN: project-euler.134
 ! DESCRIPTION
 ! -----------
 
-! Consider the consecutive primes p1 = 19 and p2 = 23. It can be
+! Consider the consecutive primes p1 = 19 and p2 = 23. It can be verified that
-! verified that 1219 is the smallest number such that the last digits
+! 1219 is the smallest number such that the last digits are formed by p1 whilst
-! are formed by p1 whilst also being divisible by p2.
+! also being divisible by p2.
 
 ! In fact, with the exception of p1 = 3 and p2 = 5, for every pair of
-! consecutive primes, p2 p1, there exist values of n for which the last
+! consecutive primes, p2 p1, there exist values of n for which the last digits
-! digits are formed by p1 and n is divisible by p2. Let S be the
+! are formed by p1 and n is divisible by p2. Let S be the smallest of these
-! smallest of these values of n.
+! values of n.
 
 ! Find S for every pair of consecutive primes with 5 p1 1000000.
 
+
 ! SOLUTION
 ! --------
 
-! Compute the smallest power of 10 greater than m or equal to it
+! Compute the smallest power of 10 greater than or equal to m
 : next-power-of-10 ( m -- n )
-  10 swap log 10 log / ceiling >integer ^ ; foldable
+    10 swap log10 ceiling >integer ^ ; foldable
+
+<PRIVATE
 
 ! Compute S for a given pair (p1, p2) -- that is the smallest positive
 ! number such that X = p1 [npt] and X = 0 [p2] (npt being the smallest
@@ -33,10 +36,13 @@ IN: project-euler.134
 : s ( p1 p2 -- s )
     over 0 2array rot next-power-of-10 rot 2array chinese-remainder ;
 
+PRIVATE>
+
 : euler134 ( -- answer )
-  0 5 lprimes-from uncons [ 1000000 > ] luntil [ [ s + ] keep ] leach drop ;
+    0 5 lprimes-from uncons [ 1000000 > ] luntil
+    [ [ s + ] keep ] leach drop ;
 
 ! [ euler134 ] 10 ave-time
-! 3797 ms run / 30 ms GC ave time - 10 trials
+! 2430 ms run / 36 ms GC ave time - 10 trials
 
 MAIN: euler134

extra/project-euler/169/169.factor

@@ -8,11 +8,11 @@ USING: combinators kernel math math.functions memoize ;
 ! DESCRIPTION
 ! -----------
 
-! Define f(0)=1 and f(n) to be the number of different ways n can be
+! Define f(0) = 1 and f(n) to be the number of different ways n can be
-! expressed as a sum of integer powers of 2 using each power no more
+! expressed as a sum of integer powers of 2 using each power no more than
-! than twice.
+! twice.
 
-! For example, f(10)=5 since there are five different ways to express 10:
+! For example, f(10) = 5 since there are five different ways to express 10:
 
 ! 1 + 1 + 8
 ! 1 + 1 + 4 + 4
@@ -22,6 +22,7 @@ USING: combinators kernel math math.functions memoize ;
 
 ! What is f(1025)?
 
+
 ! SOLUTION
 ! --------
 

extra/project-euler/173/173.factor

@@ -1,4 +1,4 @@
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.ranges sequences ;
 IN: project-euler.173
@@ -8,25 +8,29 @@ IN: project-euler.173
 ! DESCRIPTION
 ! -----------
 
-! We shall define a square lamina to be a square outline with a square
+! We shall define a square lamina to be a square outline with a square "hole"
-! "hole" so that the shape possesses vertical and horizontal
+! so that the shape possesses vertical and horizontal symmetry. For example,
-! symmetry. For example, using exactly thirty-two square tiles we can
+! using exactly thirty-two square tiles we can form two different square
-! form two different square laminae: [see URL for figure]
+! laminae: [see URL for figure]
 
-! With one-hundred tiles, and not necessarily using all of the tiles at
+! With one-hundred tiles, and not necessarily using all of the tiles at one
-! one time, it is possible to form forty-one different square laminae.
+! time, it is possible to form forty-one different square laminae.
+
+! Using up to one million tiles how many different square laminae can be formed?
 
-! Using up to one million tiles how many different square laminae can be
-! formed?
 
 ! SOLUTION
 ! --------
 
-: laminaes ( upper -- n )
+<PRIVATE
-  4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ;
+
+: laminae ( upper -- n )
+    4 / dup sqrt [1,b] 0 rot [ over /i - - ] curry reduce ;
+
+PRIVATE>
 
 : euler173 ( -- answer )
-  1000000 laminaes ;
+    1000000 laminae ;
 
 ! [ euler173 ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials

extra/project-euler/175/175.factor

@@ -8,29 +8,31 @@ IN: project-euler.175
 ! DESCRIPTION
 ! -----------
 
-! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of
+! Define f(0) = 1 and f(n) to be the number of ways to write n as a sum of
 ! powers of 2 where no power occurs more than twice.
 
-! For example, f(10)=5 since there are five different ways to express
+! For example, f(10) = 5 since there are five different ways to express
 ! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1
 
-! It can be shown that for every fraction p/q (p0, q0) there exists at
+! It can be shown that for every fraction p/q (p0, q0) there exists at least
-! least one integer n such that f(n)/f(n-1)=p/q.
+! one integer n such that f(n) / f(n-1) = p/q.
 
-! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241.  The
+! For instance, the smallest n for which f(n) / f(n-1) = 13/17 is 241. The
-! binary expansion of 241 is 11110001.  Reading this binary number from
+! binary expansion of 241 is 11110001. Reading this binary number from the most
-! the most significant bit to the least significant bit there are 4
+! significant bit to the least significant bit there are 4 one's, 3 zeroes and
-! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the
+! 1 one. We shall call the string 4,3,1 the Shortened Binary Expansion of 241.
-! Shortened Binary Expansion of 241.
 
 ! Find the Shortened Binary Expansion of the smallest n for which
-! f(n)/f(n-1)=123456789/987654321.
+! f(n) / f(n-1) = 123456789/987654321.
 
 ! Give your answer as comma separated integers, without any whitespaces.
 
+
 ! SOLUTION
 ! --------
 
+<PRIVATE
+
 : add-bits ( vec n b -- )
     over zero? [
         3drop
@@ -45,6 +47,8 @@ IN: project-euler.175
         { [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] }
     } cond ;
 
+PRIVATE>
+
 : euler175 ( -- result )
     V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
 

extra/project-euler/common/common.factor

@@ -1,31 +1,51 @@
-USING: arrays kernel hashtables math math.functions math.miller-rabin
+USING: kernel math math.functions math.miller-rabin math.parser
-    math.parser math.ranges namespaces sequences combinators.lib ;
+    math.primes.factors math.ranges namespaces sequences ;
 IN: project-euler.common
 
-! A collection of words used by more than one Project Euler solution.
+! A collection of words used by more than one Project Euler solution
+! and/or related words that could be useful for future problems.
+
+! Problems using each public word
+! -------------------------------
+! collect-consecutive - #8, #11
+! log10 - #25, #134
+! max-path - #18, #67
+! number>digits - #16, #20
+! propagate-all - #18, #67
+! sum-proper-divisors - #21
+! tau* - #12
+
 
 : nth-pair ( n seq -- nth next )
     over 1+ over nth >r nth r> ;
 
+: perfect-square? ( n -- ? )
+    dup sqrt mod zero? ;
+
 <PRIVATE
 
 : count-shifts ( seq width -- n )
     >r length 1+ r> - ;
 
-: shift-3rd ( seq obj obj -- seq obj obj )
-    rot 1 tail -rot ;
-
 : max-children ( seq -- seq )
     [ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
 
-: >multiplicity ( seq -- seq )
+! Propagate one row into the upper one
-    dup prune [
+: propagate ( bottom top -- newtop )
-        [ 2dup [ = ] curry count 2array , ] each
+    [ over 1 tail rot first2 max rot + ] map nip ;
-    ] { } make nip ; inline
 
 : reduce-2s ( n -- r s )
     dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
 
+: shift-3rd ( seq obj obj -- seq obj obj )
+    rot 1 tail -rot ;
+
+: (sum-divisors) ( n -- sum )
+    dup sqrt >fixnum [1,b] [
+        [ 2dup mod zero? [ 2dup / + , ] [ drop ] if ] each
+        dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
+    ] { } make sum ;
+
 PRIVATE>
 
 : collect-consecutive ( seq width -- seq )
@@ -33,8 +53,8 @@ PRIVATE>
         2dup count-shifts [ 2dup head shift-3rd , ] times
     ] { } make 2nip ;
 
-: divisor? ( n m -- ? )
+: log10 ( m -- n )
-    mod zero? ;
+    log 10 log / ;
 
 : max-path ( triangle -- n )
     dup length 1 > [
@@ -46,27 +66,10 @@ PRIVATE>
 : number>digits ( n -- seq )
     number>string string>digits ;
 
-: perfect-square? ( n -- ? )
+! Not strictly needed, but it is nice to be able to dump the triangle after the
-    dup sqrt divisor? ;
+! propagation
-
+: propagate-all ( triangle -- newtriangle )
-: prime-factorization ( n -- seq )
+    reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
-    [
-        2 [ over 1 > ]
-        [ 2dup divisor? [ dup , [ / ] keep ] [ next-prime ] if ]
-        [ ] while 2drop
-    ] { } make ;
-
-: prime-factorization* ( n -- seq )
-    prime-factorization >multiplicity ;
-
-: prime-factors ( n -- seq )
-    prime-factorization prune >array ;
-
-: (sum-divisors) ( n -- sum )
-    dup sqrt >fixnum [1,b] [
-        [ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
-        dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
-    ] { } make sum ;
 
 : sum-divisors ( n -- sum )
     dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
@@ -84,12 +87,12 @@ PRIVATE>
     dup sum-proper-divisors = ;
 
 ! The divisor function, counts the number of divisors
-: tau ( n -- n )
+: tau ( m -- n )
-    prime-factorization* flip second 1 [ 1+ * ] reduce ;
+    count-factors flip second 1 [ 1+ * ] reduce ;
 
 ! Optimized brute-force, is often faster than prime factorization
-: tau* ( n -- n )
+: tau* ( m -- n )
     reduce-2s [ perfect-square? -1 0 ? ] keep
     dup sqrt >fixnum [1,b] [
-        dupd divisor? [ >r 2 + r> ] when
+        dupd mod zero? [ >r 2 + r> ] when
     ] each drop * ;