From a2bcdaf69654acd1c4d387f81cfcbf35826f36bd Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Wed, 2 Jan 2008 18:57:57 -0500 Subject: [PATCH 1/8] Solution to Project Euler problem 23 --- extra/project-euler/023/023.factor | 57 ++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 extra/project-euler/023/023.factor diff --git a/extra/project-euler/023/023.factor b/extra/project-euler/023/023.factor new file mode 100644 index 0000000000..0554f033f3 --- /dev/null +++ b/extra/project-euler/023/023.factor @@ -0,0 +1,57 @@ +! 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 +! -------- + + 46 can be expressed as a sum of two abundants +: source-023 ( -- seq ) + 46 [1,b] 47 20161 2 append ; + +: abundants-below ( 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-below possible-sums source-023 seq-diff sum ; + +! [ euler023 ] time +! 52780 ms run / 3839 ms GC + +MAIN: euler023 From 75c126fef0625e22a1967e17e64b63b0c20ab613 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Wed, 2 Jan 2008 19:11:08 -0500 Subject: [PATCH 2/8] Fix path generation for Project Euler problem files --- extra/project-euler/022/022.factor | 13 ++----------- extra/project-euler/067/067.factor | 27 +++++---------------------- 2 files changed, 7 insertions(+), 33 deletions(-) diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor index f523f586c5..5d33a8e50c 100644 --- a/extra/project-euler/022/022.factor +++ b/extra/project-euler/022/022.factor @@ -27,18 +27,9 @@ IN: project-euler.022 digits [ 9 - ] sigma ; diff --git a/extra/project-euler/067/067.factor b/extra/project-euler/067/067.factor index a675a5635e..00b49a063b 100644 --- a/extra/project-euler/067/067.factor +++ b/extra/project-euler/067/067.factor @@ -37,14 +37,14 @@ IN: project-euler.067 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 +53,13 @@ PRIVATE> ! ALTERNATE SOLUTIONS ! ------------------- - 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 -! 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 From 0a6975c4231e09744ac2d5ccc24914beebadbd50 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Thu, 3 Jan 2008 01:49:46 -0500 Subject: [PATCH 3/8] Solution to Project Euler problem 24 --- extra/project-euler/023/023.factor | 14 ++++--- extra/project-euler/024/024.factor | 48 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 3 +- 3 files changed, 59 insertions(+), 6 deletions(-) create mode 100644 extra/project-euler/024/024.factor diff --git a/extra/project-euler/023/023.factor b/extra/project-euler/023/023.factor index 0554f033f3..06f6555ea3 100644 --- a/extra/project-euler/023/023.factor +++ b/extra/project-euler/023/023.factor @@ -31,25 +31,29 @@ IN: project-euler.023 ! SOLUTION ! -------- - 46 can be expressed as a sum of two abundants + + append ; -: abundants-below ( n -- seq ) +: abundants-upto ( n -- seq ) [1,b] [ abundant? ] subset ; : possible-sums ( seq -- seq ) dup { } -rot [ - dupd [ + ] curry map rot append prune swap 1 tail + dupd [ + ] curry map + rot append prune swap 1 tail ] each drop natural-sort ; PRIVATE> : euler023 ( -- answer ) - 20161 abundants-below possible-sums source-023 seq-diff sum ; + 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 diff --git a/extra/project-euler/024/024.factor b/extra/project-euler/024/024.factor new file mode 100644 index 0000000000..d06f8a702d --- /dev/null +++ b/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 +! -------- + +permutation) ( seq n -- seq ) + [ [ dupd >= [ 1+ ] when ] curry map ] keep add* ; + +: >permutation ( factoradic -- permutation ) + reverse 1 cut [ (>permutation) ] each ; + +PRIVATE> + +: 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 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index a6dc9bd467..a796ad39a1 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -7,7 +7,8 @@ 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.067 project-euler.134 ; IN: project-euler Date: Thu, 3 Jan 2008 12:21:45 -0500 Subject: [PATCH 4/8] Solution to Project Euler problem 25 --- extra/project-euler/002/002.factor | 6 +-- extra/project-euler/025/025.factor | 57 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 1 + 3 files changed, 61 insertions(+), 3 deletions(-) create mode 100644 extra/project-euler/025/025.factor diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index 386d847e27..4449968642 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -20,13 +20,13 @@ IN: project-euler.002 ! -------- : last2 ( seq -- elt last ) - reverse first2 swap ; + 2 tail* first2 ; -: fib-up-to ( n -- seq ) +: fib-upto ( n -- seq ) { 0 } 1 [ pick dupd < ] [ add dup last2 + ] [ ] while drop nip ; : 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 diff --git a/extra/project-euler/025/025.factor b/extra/project-euler/025/025.factor new file mode 100644 index 0000000000..2da1ee6b57 --- /dev/null +++ b/extra/project-euler/025/025.factor @@ -0,0 +1,57 @@ +! Copyright (c) 2007 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.parser memoize 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 +! -------- + +MEMO: fib ( m -- n ) + dup 1 > [ 1 - dup fib swap 1 - fib + ] when ; + +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 + +MAIN: euler025 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index a796ad39a1..25db0db26f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -8,6 +8,7 @@ USING: definitions io io.files kernel math.parser sequences vocabs 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.023 project-euler.024 + project-euler.025 project-euler.067 project-euler.134 ; IN: project-euler From 03fa8a4887101563a1cd54f4934d4098c2763008 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Fri, 4 Jan 2008 01:40:01 -0500 Subject: [PATCH 5/8] Alternate solution to Project Euler problem 25 --- extra/project-euler/025/025.factor | 33 ++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/extra/project-euler/025/025.factor b/extra/project-euler/025/025.factor index 2da1ee6b57..8d75ef5493 100644 --- a/extra/project-euler/025/025.factor +++ b/extra/project-euler/025/025.factor @@ -1,6 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.parser memoize sequences ; +USING: alien.syntax kernel math math.functions math.parser math.ranges memoize + sequences ; IN: project-euler.025 ! http://projecteuler.net/index.php?section=problems&id=25 @@ -35,6 +36,8 @@ IN: project-euler.025 ! SOLUTION ! -------- +! Memoized brute force + MEMO: fib ( m -- n ) dup 1 > [ 1 - dup fib swap 1 - fib + ] when ; @@ -54,4 +57,30 @@ PRIVATE> ! [ euler025 ] 10 ave-time ! 5237 ms run / 72 ms GC ave time - 10 trials -MAIN: euler025 + +! 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 + +integer ; + +PRIVATE> + +: euler025a ( -- answer ) + 1000 digit-fib* ; + +! [ euler025a ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler025a From 4fa639a50b51f8a0fba109ce2fe25124bd213a12 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sat, 5 Jan 2008 10:43:18 +0100 Subject: [PATCH 6/8] Add missing project Euler solutions to the list --- extra/project-euler/project-euler.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 250a92b953..0be847623e 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -7,7 +7,8 @@ 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.067 project-euler.134 + project-euler.169 project-euler.173 project-euler.175 ; IN: project-euler Date: Sun, 6 Jan 2008 21:18:59 -0500 Subject: [PATCH 7/8] Cleanup of all Project Euler solutions thus far --- extra/project-euler/002/002.factor | 10 ++- extra/project-euler/003/003.factor | 9 +-- extra/project-euler/004/004.factor | 6 +- extra/project-euler/005/005.factor | 2 +- extra/project-euler/007/007.factor | 8 +-- extra/project-euler/008/008.factor | 2 +- extra/project-euler/009/009.factor | 14 ++--- extra/project-euler/010/010.factor | 2 +- extra/project-euler/012/012.factor | 2 +- extra/project-euler/013/013.factor | 2 +- extra/project-euler/014/014.factor | 11 ++-- extra/project-euler/016/016.factor | 2 +- extra/project-euler/017/017.factor | 52 +--------------- extra/project-euler/018/018.factor | 72 ++++++---------------- extra/project-euler/019/019.factor | 7 ++- extra/project-euler/020/020.factor | 2 +- extra/project-euler/022/022.factor | 6 +- extra/project-euler/024/024.factor | 4 +- extra/project-euler/025/025.factor | 6 +- extra/project-euler/067/067.factor | 7 +-- extra/project-euler/134/134.factor | 30 +++++---- extra/project-euler/169/169.factor | 21 ++++--- extra/project-euler/173/173.factor | 28 +++++---- extra/project-euler/175/175.factor | 46 +++++++------- extra/project-euler/common/common.factor | 77 ++++++++++++------------ 25 files changed, 182 insertions(+), 246 deletions(-) diff --git a/extra/project-euler/002/002.factor b/extra/project-euler/002/002.factor index 4449968642..b9375b7d1e 100644 --- a/extra/project-euler/002/002.factor +++ b/extra/project-euler/002/002.factor @@ -19,11 +19,15 @@ IN: project-euler.002 ! SOLUTION ! -------- -: last2 ( seq -- elt last ) - 2 tail* first2 ; +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 ; diff --git a/extra/project-euler/003/003.factor b/extra/project-euler/003/003.factor index 2b229aa11b..afc4069aee 100644 --- a/extra/project-euler/003/003.factor +++ b/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 -! 2 ms run / 0 ms GC time +! [ euler003 ] 100 ave-time +! 1 ms run / 0 ms GC ave time - 100 trials MAIN: euler003 diff --git a/extra/project-euler/004/004.factor b/extra/project-euler/004/004.factor index dadde25411..0db0c6f2cb 100644 --- a/extra/project-euler/004/004.factor +++ b/extra/project-euler/004/004.factor @@ -26,14 +26,16 @@ IN: project-euler.004 : euler004 ( -- answer ) - 100 999 [a,b] [ 10 mod zero? not ] subset dup - cartesian-product [ product ] map prune max-palindrome ; + source-004 dup cartesian-product [ product ] map prune max-palindrome ; ! [ euler004 ] 100 ave-time ! 1608 ms run / 102 ms GC ave time - 100 trials diff --git a/extra/project-euler/005/005.factor b/extra/project-euler/005/005.factor index ff627e4a0e..0d8f11f243 100644 --- a/extra/project-euler/005/005.factor +++ b/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 diff --git a/extra/project-euler/007/007.factor b/extra/project-euler/007/007.factor index 12f06972a9..93754b69d1 100644 --- a/extra/project-euler/007/007.factor +++ b/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 ; + 10001 nth-prime ; -! [ euler007 ] time -! 22 ms run / 0 ms GC time +! [ euler007 ] 100 ave-time +! 10 ms run / 0 ms GC ave time - 100 trials MAIN: euler007 diff --git a/extra/project-euler/008/008.factor b/extra/project-euler/008/008.factor index d76f344279..8b32d5651e 100644 --- a/extra/project-euler/008/008.factor +++ b/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 diff --git a/extra/project-euler/009/009.factor b/extra/project-euler/009/009.factor index 44569149d5..f09643d290 100644 --- a/extra/project-euler/009/009.factor +++ b/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 swap sq swap + 2 / , ! c = (p² + q²) / 2 + 2dup * , ! a = p * q + [ sq ] 2apply 2dup - 2 / , ! b = (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 - [ - next-pq 2dup abc (ptriplet) - ] unless ; + roll [ swap sum = ] keep -roll + [ next-pq 2dup abc (ptriplet) ] unless ; : ptriplet ( target -- triplet ) 3 1 { 3 4 5 } (ptriplet) abc nip ; diff --git a/extra/project-euler/010/010.factor b/extra/project-euler/010/010.factor index 1baf9500a1..172bb9d290 100644 --- a/extra/project-euler/010/010.factor +++ b/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 diff --git a/extra/project-euler/012/012.factor b/extra/project-euler/012/012.factor index 0d0d4161e4..3d59549e69 100644 --- a/extra/project-euler/012/012.factor +++ b/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 diff --git a/extra/project-euler/013/013.factor b/extra/project-euler/013/013.factor index be968fc346..907029cfb2 100644 --- a/extra/project-euler/013/013.factor +++ b/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 diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index 7c1f0d41f9..02c5dbb9d3 100644 --- a/extra/project-euler/014/014.factor +++ b/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> @@ -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 diff --git a/extra/project-euler/016/016.factor b/extra/project-euler/016/016.factor index 866b0ed522..00747a9317 100644 --- a/extra/project-euler/016/016.factor +++ b/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 diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index 1fdb6c5484..aa47f0cda0 100644 --- a/extra/project-euler/017/017.factor +++ b/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 - strings ; +USING: combinators.lib kernel math.ranges math.text sequences strings ; IN: project-euler.017 ! http://projecteuler.net/index.php?section=problems&id=17 @@ -23,55 +22,10 @@ IN: project-euler.017 ! SOLUTION ! -------- - - -: >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 diff --git a/extra/project-euler/018/018.factor b/extra/project-euler/018/018.factor index 2dc05db1b1..eb2df5e0da 100644 --- a/extra/project-euler/018/018.factor +++ b/extra/project-euler/018/018.factor @@ -50,39 +50,28 @@ IN: project-euler.018 -! 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 ! ------------------- - - : 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 diff --git a/extra/project-euler/019/019.factor b/extra/project-euler/019/019.factor index f811b98e10..58a2dc9668 100644 --- a/extra/project-euler/019/019.factor +++ b/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 ) - 1901 2000 [a,b] [ 12 [1,b] [ 1 zeller-congruence ] 1 map-withn ] map concat - [ 0 = ] subset length ; +: euler019 ( -- answer ) + 1901 2000 [a,b] [ + 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 diff --git a/extra/project-euler/020/020.factor b/extra/project-euler/020/020.factor index 498aad16ad..8ac75bd9ff 100644 --- a/extra/project-euler/020/020.factor +++ b/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 diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor index 5d33a8e50c..b4910e5885 100644 --- a/extra/project-euler/022/022.factor +++ b/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 - sorting splitting strings system vocabs ; +USING: io.files kernel math math.parser namespaces sequences sorting splitting + 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 ; diff --git a/extra/project-euler/024/024.factor b/extra/project-euler/024/024.factor index d06f8a702d..44434b4a88 100644 --- a/extra/project-euler/024/024.factor +++ b/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 ; diff --git a/extra/project-euler/025/025.factor b/extra/project-euler/025/025.factor index 8d75ef5493..2819e210a7 100644 --- a/extra/project-euler/025/025.factor +++ b/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 ; 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 diff --git a/extra/project-euler/134/134.factor b/extra/project-euler/134/134.factor index 55f8a8dab8..fb7fdebd51 100644 --- a/extra/project-euler/134/134.factor +++ b/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,34 +9,40 @@ IN: project-euler.134 ! DESCRIPTION ! ----------- -! Consider the consecutive primes p1 = 19 and p2 = 23. It can be -! verified that 1219 is the smallest number such that the last digits -! are formed by p1 whilst also being divisible by p2. +! Consider the consecutive primes p1 = 19 and p2 = 23. It can be verified that +! 1219 is the smallest number such that the last digits are formed by p1 whilst +! 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 -! digits are formed by p1 and n is divisible by p2. Let S be the -! smallest of these values of n. +! consecutive primes, p2 p1, there exist values of n for which the last digits +! are formed by p1 and n is divisible by p2. Let S be the smallest of these +! 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 + + : 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 diff --git a/extra/project-euler/169/169.factor b/extra/project-euler/169/169.factor index 959715e4f9..61645bf50b 100644 --- a/extra/project-euler/169/169.factor +++ b/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 -! expressed as a sum of integer powers of 2 using each power no more -! than twice. +! 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 than +! 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,18 +22,19 @@ USING: combinators kernel math math.functions memoize ; ! What is f(1025)? + ! SOLUTION ! -------- MEMO: fn ( n -- x ) - { - { [ dup 2 < ] [ drop 1 ] } - { [ dup odd? ] [ 2/ fn ] } - { [ t ] [ 2/ [ fn ] keep 1- fn + ] } - } cond ; + { + { [ dup 2 < ] [ drop 1 ] } + { [ dup odd? ] [ 2/ fn ] } + { [ t ] [ 2/ [ fn ] keep 1- fn + ] } + } cond ; : euler169 ( -- result ) - 10 25 ^ fn ; + 10 25 ^ fn ; ! [ euler169 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/173/173.factor b/extra/project-euler/173/173.factor index 4eef3ec3e2..9f2984d37d 100644 --- a/extra/project-euler/173/173.factor +++ b/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 -! "hole" so that the shape possesses vertical and horizontal -! symmetry. For example, using exactly thirty-two square tiles we can -! form two different square laminae: [see URL for figure] +! We shall define a square lamina to be a square outline with a square "hole" +! so that the shape possesses vertical and horizontal symmetry. For example, +! using exactly thirty-two square tiles we can form two different square +! laminae: [see URL for figure] -! With one-hundred tiles, and not necessarily using all of the tiles at -! one time, it is possible to form forty-one different square laminae. +! With one-hundred tiles, and not necessarily using all of the tiles at one +! 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 ) - 4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ; + : euler173 ( -- answer ) - 1000000 laminaes ; + 1000000 laminae ; ! [ euler173 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/175/175.factor b/extra/project-euler/175/175.factor index db1760c017..e6b4acc8c0 100644 --- a/extra/project-euler/175/175.factor +++ b/extra/project-euler/175/175.factor @@ -8,45 +8,49 @@ 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 -! least one integer n such that f(n)/f(n-1)=p/q. +! It can be shown that for every fraction p/q (p0, q0) there exists at least +! 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 -! the most significant bit to the least significant bit there are 4 -! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the -! Shortened Binary Expansion of 241. +! 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 the most +! significant bit to the least significant bit there are 4 one's, 3 zeroes and +! 1 one. We shall call the string 4,3,1 the 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 ! -------- +integer 0 add-bits ] } - } cond ; + { + { [ dup integer? ] [ 1- 0 add-bits ] } + { [ dup 1 < ] [ 1 over - / dupd compute 1 1 add-bits ] } + { [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] } + } cond ; + +PRIVATE> : euler175 ( -- result ) - V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ; + V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ; ! [ euler175 ] 100 ave-time ! 0 ms run / 0 ms GC ave time - 100 trials diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 2e18d744fc..6279606481 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -1,31 +1,51 @@ -USING: arrays kernel hashtables math math.functions math.miller-rabin - math.parser math.ranges namespaces sequences combinators.lib ; +USING: kernel math math.functions math.miller-rabin math.parser + 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? ; + 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 ) - dup prune [ - [ 2dup [ = ] curry count 2array , ] each - ] { } make nip ; inline +! Propagate one row into the upper one +: propagate ( bottom top -- newtop ) + [ over 1 tail rot first2 max rot + ] map nip ; : 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 -- ? ) - mod zero? ; +: log10 ( m -- n ) + 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 -- ? ) - dup sqrt divisor? ; - -: prime-factorization ( n -- seq ) - [ - 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 ; +! 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 1 tail [ propagate dup ] map nip reverse swap add ; : 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 ) - prime-factorization* flip second 1 [ 1+ * ] reduce ; +: tau ( m -- n ) + 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 * ; From 947e64c6307a98f09e528266a460d06c1df2ec82 Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Sun, 6 Jan 2008 22:21:58 -0500 Subject: [PATCH 8/8] Move math.text to math.text.english for localization --- extra/math/text/{ => english}/authors.txt | 0 .../{text-docs.factor => english/english-docs.factor} | 2 +- .../{text-tests.factor => english/english-tests.factor} | 2 +- extra/math/text/{text.factor => english/english.factor} | 8 ++------ extra/math/text/english/summary.txt | 1 + extra/math/text/summary.txt | 1 - extra/project-euler/017/017.factor | 2 +- 7 files changed, 6 insertions(+), 10 deletions(-) rename extra/math/text/{ => english}/authors.txt (100%) rename extra/math/text/{text-docs.factor => english/english-docs.factor} (94%) rename extra/math/text/{text-tests.factor => english/english-tests.factor} (93%) rename extra/math/text/{text.factor => english/english.factor} (96%) create mode 100644 extra/math/text/english/summary.txt delete mode 100644 extra/math/text/summary.txt diff --git a/extra/math/text/authors.txt b/extra/math/text/english/authors.txt similarity index 100% rename from extra/math/text/authors.txt rename to extra/math/text/english/authors.txt diff --git a/extra/math/text/text-docs.factor b/extra/math/text/english/english-docs.factor similarity index 94% rename from extra/math/text/text-docs.factor rename to extra/math/text/english/english-docs.factor index 6a896b1a82..d544f49ad8 100644 --- a/extra/math/text/text-docs.factor +++ b/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 } } diff --git a/extra/math/text/text-tests.factor b/extra/math/text/english/english-tests.factor similarity index 93% rename from extra/math/text/text-tests.factor rename to extra/math/text/english/english-tests.factor index 09c8a0461b..00fccde1d3 100644 --- a/extra/math/text/text-tests.factor +++ b/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 diff --git a/extra/math/text/text.factor b/extra/math/text/english/english.factor similarity index 96% rename from extra/math/text/text.factor rename to extra/math/text/english/english.factor index 7298fd3c15..a6179382bd 100644 --- a/extra/math/text/text.factor +++ b/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 ] - } && and-needed? set drop ; + first { [ dup 100 < ] [ dup 0 > ] } && and-needed? set drop ; : negative-text ( n -- str ) 0 < "Negative " "" ? ; @@ -100,4 +97,3 @@ PRIVATE> ] [ [ (number>text) ] with-scope ] if ; - diff --git a/extra/math/text/english/summary.txt b/extra/math/text/english/summary.txt new file mode 100644 index 0000000000..cac4ccb222 --- /dev/null +++ b/extra/math/text/english/summary.txt @@ -0,0 +1 @@ +Convert integers to English text diff --git a/extra/math/text/summary.txt b/extra/math/text/summary.txt deleted file mode 100644 index 96b2f4f151..0000000000 --- a/extra/math/text/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Convert integers to text diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index aa47f0cda0..296818db07 100644 --- a/extra/project-euler/017/017.factor +++ b/extra/project-euler/017/017.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib kernel math.ranges math.text sequences strings ; +USING: combinators.lib kernel math.ranges math.text.english sequences strings ; IN: project-euler.017 ! http://projecteuler.net/index.php?section=problems&id=17