Fix conflict

extra/math/text/english/english-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax math strings ;
-IN: math.text
+IN: math.text.english
 
 HELP: number>text
 { $values { "n" integer } { "str" string } }

extra/math/text/english/english-tests.factor

@@ -1,4 +1,4 @@
-USING: math.functions math.text tools.test ;
+USING: math.functions math.text.english tools.test ;
 IN: temporary
 
 [ "Zero" ] [ 0 number>text ] unit-test

extra/math/text/english/english.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators.lib kernel math math.functions math.parser namespaces
     sequences splitting sequences.lib ;
-IN: math.text
+IN: math.text.english
 
 <PRIVATE
 
@@ -26,10 +26,7 @@ IN: math.text
 
 SYMBOL: and-needed?
 : set-conjunction ( seq -- )
-    first {
+    first { [ dup 100 < ] [ dup 0 > ] } && and-needed? set drop ;
-        [ dup 100 < ]
-        [ dup 0 > ]
-    } && and-needed? set drop ;
 
 : negative-text ( n -- str )
     0 < "Negative " "" ? ;
@@ -100,4 +97,3 @@ PRIVATE>
     ] [
         [ (number>text) ] with-scope
     ] if ;
-

extra/math/text/english/summary.txt

@@ -0,0 +1 @@
+Convert integers to English text

extra/math/text/summary.txt

@@ -1 +0,0 @@
-Convert integers to text

extra/project-euler/002/002.factor

@@ -19,14 +19,18 @@ IN: project-euler.002
 ! SOLUTION
 ! --------
 
-: last2 ( seq -- elt last )
+<PRIVATE
-    reverse first2 swap ;
 
-: fib-up-to ( n -- seq )
+: (fib-upto) ( seq n limit -- seq )
-    { 0 } 1 [ pick dupd < ] [ add dup last2 + ] [ ] while drop nip ;
+    2dup <= [ >r add dup 2 tail* sum r> (fib-upto) ] [ 2drop ] if ;
+
+PRIVATE>
+
+: fib-upto ( n -- seq )
+    { 0 } 1 rot (fib-upto) ;
 
 : euler002 ( -- answer )
-    1000000 fib-up-to [ even? ] subset sum ;
+    1000000 fib-upto [ even? ] subset sum ;
 
 ! [ euler002 ] 100 ave-time
 ! 0 ms run / 0 ms GC ave time - 100 trials

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

@@ -23,7 +23,7 @@ IN: project-euler.007
 : 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.english 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
@@ -27,21 +27,12 @@ IN: project-euler.022
 
 <PRIVATE
 
-: (source-022) ( -- path )
-    [
-        "project-euler.022" vocab-root ?resource-path %
-        os "windows" = [
-            "\\project-euler\\022\\names.txt" %
-        ] [
-            "/project-euler/022/names.txt" %
-        ] if
-    ] "" make ;
-
 : source-022 ( -- seq )
-    (source-022) file-contents [ quotable? ] subset "," split ;
+    "extra/project-euler/022/names.txt" resource-path
+    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/023/023.factor

@@ -0,0 +1,61 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: hashtables kernel math math.ranges project-euler.common sequences
+    sorting ;
+IN: project-euler.023
+
+! http://projecteuler.net/index.php?section=problems&id=23
+
+! DESCRIPTION
+! -----------
+
+! A perfect number is a number for which the sum of its proper divisors is
+! exactly equal to the number. For example, the sum of the proper divisors of
+! 28 would be 1 + 2 + 4 + 7 + 14 = 28, which means that 28 is a perfect number.
+
+! A number whose proper divisors are less than the number is called deficient
+! and a number whose proper divisors exceed the number is called abundant.
+
+! As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest
+! number that can be written as the sum of two abundant numbers is 24. By
+! mathematical analysis, it can be shown that all integers greater than 28123
+! can be written as the sum of two abundant numbers. However, this upper limit
+! cannot be reduced any further by analysis even though it is known that the
+! greatest number that cannot be expressed as the sum of two abundant numbers
+! is less than this limit.
+
+! Find the sum of all the positive integers which cannot be written as the sum
+! of two abundant numbers.
+
+
+! SOLUTION
+! --------
+
+! The upper limit can be dropped to 20161 which reduces our search space
+! and every even number > 46 can be expressed as a sum of two abundants
+
+<PRIVATE
+
+: source-023 ( -- seq )
+    46 [1,b] 47 20161 2 <range> append ;
+
+: abundants-upto ( n -- seq )
+    [1,b] [ abundant? ] subset ;
+
+: possible-sums ( seq -- seq )
+    dup { } -rot [
+        dupd [ + ] curry map
+        rot append prune swap 1 tail
+    ] each drop natural-sort ;
+
+PRIVATE>
+
+: euler023 ( -- answer )
+    20161 abundants-upto possible-sums source-023 seq-diff sum ;
+
+! TODO: solution is still too slow, although it takes under 1 minute
+
+! [ euler023 ] time
+! 52780 ms run / 3839 ms GC
+
+MAIN: euler023

extra/project-euler/024/024.factor

@@ -0,0 +1,48 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.parser math.ranges namespaces sequences ;
+IN: project-euler.024
+
+! http://projecteuler.net/index.php?section=problems&id=24
+
+! DESCRIPTION
+! -----------
+
+! A permutation is an ordered arrangement of objects. For example, 3124 is one
+! possible permutation of the digits 1, 2, 3 and 4. If all of the permutations
+! are listed numerically or alphabetically, we call it lexicographic order. The
+! lexicographic permutations of 0, 1 and 2 are:
+
+!     012   021   102   120   201   210
+
+! What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4,
+! 5, 6, 7, 8 and 9?
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: (>permutation) ( seq n -- seq )
+    [ [ dupd >= [ 1+ ] when ] curry map ] keep add* ;
+
+PRIVATE>
+
+: >permutation ( factoradic -- permutation )
+    reverse 1 cut [ (>permutation) ] each ;
+
+: factoradic ( k order -- factoradic )
+    [ [1,b] [ 2dup mod , /i ] each ] { } make reverse nip ;
+
+: permutation ( k seq -- seq )
+    dup length swapd factoradic >permutation
+    [ [ dupd swap nth , ] each drop ] { } make ;
+
+: euler024 ( -- answer )
+    999999 10 permutation 10 swap digits>integer ;
+
+! [ euler024 ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler024

extra/project-euler/025/025.factor

@@ -0,0 +1,84 @@
+! 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
+    project-euler.common sequences ;
+IN: project-euler.025
+
+! http://projecteuler.net/index.php?section=problems&id=25
+
+! DESCRIPTION
+! -----------
+
+! The Fibonacci sequence is defined by the recurrence relation:
+
+!     Fn = Fn-1 + Fn-2, where F1 = 1 and F2 = 1.
+
+! Hence the first 12 terms will be:
+
+!     F1 = 1
+!     F2 = 1
+!     F3 = 2
+!     F4 = 3
+!     F5 = 5
+!     F6 = 8
+!     F7 = 13
+!     F8 = 21
+!     F9 = 34
+!     F10 = 55
+!     F11 = 89
+!     F12 = 144
+
+! The 12th term, F12, is the first term to contain three digits.
+
+! What is the first term in the Fibonacci sequence to contain 1000 digits?
+
+
+! SOLUTION
+! --------
+
+! Memoized brute force
+
+MEMO: fib ( m -- n )
+    dup 1 > [ 1- dup fib swap 1- fib + ] when ;
+
+<PRIVATE
+
+: (digit-fib) ( n term -- term )
+    2dup fib number>string length > [ 1+ (digit-fib) ] [ nip ] if ;
+
+: digit-fib ( n -- term )
+    1 (digit-fib) ;
+
+PRIVATE>
+
+: euler025 ( -- answer )
+    1000 digit-fib ;
+
+! [ euler025 ] 10 ave-time
+! 5237 ms run / 72 ms GC ave time - 10 trials
+
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+! A number containing 1000 digits is the same as saying it's greater than 10**999
+! The nth Fibonacci number is Phi**n / sqrt(5) rounded to the nearest integer
+! Thus we need we need "Phi**n / sqrt(5) > 10**999", and we just solve for n
+
+<PRIVATE
+
+: phi ( -- phi )
+    5 sqrt 1+ 2 / ;
+
+: digit-fib* ( n -- term )
+    1- 5 log10 2 / + phi log10 / ceiling >integer ;
+
+PRIVATE>
+
+: euler025a ( -- answer )
+    1000 digit-fib* ;
+
+! [ euler025a ] 100 ave-time
+! 0 ms run / 0 ms GC ave time - 100 trials
+
+MAIN: euler025a

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
@@ -37,14 +36,14 @@ IN: project-euler.067
 
 <PRIVATE
 
-: pyramid ( -- seq )
+: source-067 ( -- seq )
-    "resource:extra/project-euler/067/triangle.txt" ?resource-path
+    "extra/project-euler/067/triangle.txt" resource-path
     file-lines [ " " split [ string>number ] map ] map ;
 
 PRIVATE>
 
 : euler067 ( -- answer )
-    pyramid propagate-all first first ;
+    source-067 propagate-all first first ;
 
 ! [ euler067 ] 100 ave-time
 ! 18 ms run / 0 ms GC time
@@ -53,30 +52,13 @@ PRIVATE>
 ! ALTERNATE SOLUTIONS
 ! -------------------
 
-<PRIVATE
-
-: (source-067a) ( -- path )
-    [
-        "project-euler.067" vocab-root ?resource-path %
-        os "windows" = [
-            "\\project-euler\\067\\triangle.txt" %
-        ] [
-            "/project-euler/067/triangle.txt" %
-        ] if
-    ] "" make ;
-
-: source-067a ( -- triangle )
-    (source-067a) file-lines [ " " split [ string>number ] map ] map ;
-
-PRIVATE>
-
 : euler067a ( -- answer )
-    source-067a max-path ;
+    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-067a [ max-path ] curry 100 ave-time
+! source-067 [ max-path ] curry 100 ave-time
 ! 3 ms run / 0 ms GC ave time - 100 trials
 
 MAIN: euler067a

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

@@ -9,8 +9,8 @@ USING: combinators kernel math math.functions memoize ;
 ! -----------
 
 ! 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:
 
@@ -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

@@ -14,23 +14,25 @@ IN: project-euler.175
 ! 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
-! 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.
 
 ! 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 * ;

extra/project-euler/project-euler.factor

@@ -7,7 +7,9 @@ USING: definitions io io.files kernel math.parser sequences vocabs
     project-euler.009 project-euler.010 project-euler.011 project-euler.012
     project-euler.013 project-euler.014 project-euler.015 project-euler.016
     project-euler.017 project-euler.018 project-euler.019 project-euler.020
-    project-euler.021 project-euler.022 project-euler.067 project-euler.134 ;
+    project-euler.021 project-euler.022 project-euler.023 project-euler.024
+    project-euler.025 project-euler.067 project-euler.134 project-euler.169
+    project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE