From dc18466c271b62394208fe2b619e323f4f87060c Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sun, 30 Dec 2007 13:08:31 +0100 Subject: [PATCH 1/7] Project Euler solutions are not always numbers --- extra/project-euler/project-euler.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 601acb70b5..4cd4a3826e 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: definitions io io.files kernel math.parser sequences strings +USING: definitions io io.files kernel math math.parser sequences strings vocabs vocabs.loader project-euler.001 project-euler.002 project-euler.003 project-euler.004 project-euler.005 project-euler.006 project-euler.007 project-euler.008 @@ -32,7 +32,7 @@ PRIVATE> : run-project-euler ( -- ) problem-prompt dup problem-solved? [ dup number>euler "project-euler." swap append run - "Answer: " swap number>string append print + "Answer: " swap dup number? [ number>string ] when append print "Source: " swap solution-path append print ] [ drop "That problem has not been solved yet..." print From 392da8029fa067444406d98ae61a30655c7ccb53 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sat, 29 Dec 2007 01:18:00 +0100 Subject: [PATCH 2/7] Factor solution to project Euler problem 175 --- extra/project-euler/175/175.factor | 54 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 3 +- 2 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 extra/project-euler/175/175.factor diff --git a/extra/project-euler/175/175.factor b/extra/project-euler/175/175.factor new file mode 100644 index 0000000000..db1760c017 --- /dev/null +++ b/extra/project-euler/175/175.factor @@ -0,0 +1,54 @@ +! Copyright (c) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators kernel math math.parser math.ranges sequences vectors ; +IN: project-euler.175 + +! http://projecteuler.net/index.php?section=problems&id=175 + +! DESCRIPTION +! ----------- + +! 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 +! 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. + +! 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. + +! Give your answer as comma separated integers, without any whitespaces. + +! SOLUTION +! -------- + +: add-bits ( vec n b -- ) + over zero? [ + 3drop + ] [ + pick length 1 bitand = [ over pop + ] when swap push + ] if ; + +: compute ( vec ratio -- ) + { + { [ 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 ; + +: euler175 ( -- result ) + 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 + +MAIN: euler175 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 4cd4a3826e..9b5c41feed 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -8,7 +8,8 @@ USING: definitions io io.files kernel math math.parser sequences strings project-euler.013 project-euler.014 project-euler.015 project-euler.016 project-euler.017 project-euler.018 project-euler.019 project-euler.067 - project-euler.134 ; + project-euler.134 + project-euler.175 ; IN: project-euler Date: Sun, 30 Dec 2007 13:30:26 +0100 Subject: [PATCH 3/7] Factor solution to project Euler problem 169 --- extra/project-euler/169/169.factor | 41 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 1 + 2 files changed, 42 insertions(+) create mode 100644 extra/project-euler/169/169.factor diff --git a/extra/project-euler/169/169.factor b/extra/project-euler/169/169.factor new file mode 100644 index 0000000000..959715e4f9 --- /dev/null +++ b/extra/project-euler/169/169.factor @@ -0,0 +1,41 @@ +! Copyright (c) 2007 Samuel Tardieu. +! See http://factorcode.org/license.txt for BSD license. +IN: project-euler.169 +USING: combinators kernel math math.functions memoize ; + +! http://projecteuler.net/index.php?section=problems&id=169 + +! 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. + +! For example, f(10)=5 since there are five different ways to express 10: + +! 1 + 1 + 8 +! 1 + 1 + 4 + 4 +! 1 + 1 + 2 + 2 + 4 +! 2 + 4 + 4 +! 2 + 8 + +! What is f(1025)? + +! SOLUTION +! -------- + +MEMO: fn ( n -- x ) + { + { [ dup 2 < ] [ drop 1 ] } + { [ dup odd? ] [ 2/ fn ] } + { [ t ] [ 2/ [ fn ] keep 1- fn + ] } + } cond ; + +: euler169 ( -- result ) + 10 25 ^ fn ; + +! [ euler169 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler169 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 9b5c41feed..f256f03138 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -9,6 +9,7 @@ USING: definitions io io.files kernel math math.parser sequences strings project-euler.017 project-euler.018 project-euler.019 project-euler.067 project-euler.134 + project-euler.169 project-euler.175 ; IN: project-euler From b55f6d91145ba8bbc8d2573abe5cb3b3d3203ba0 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 31 Dec 2007 00:24:24 +0100 Subject: [PATCH 4/7] Use constant stack effect to prevent compilation errors --- extra/project-euler/011/011.factor | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/extra/project-euler/011/011.factor b/extra/project-euler/011/011.factor index 9739ee971c..7520fb9182 100644 --- a/extra/project-euler/011/011.factor +++ b/extra/project-euler/011/011.factor @@ -72,13 +72,13 @@ IN: project-euler.011 : pad-front ( matrix -- matrix ) [ - length [ 0 ] each - ] keep [ append ] map ; + length [ 0 ] map + ] keep [ append ] 2map ; : pad-back ( matrix -- matrix ) [ - length [ 0 ] each - ] keep [ append ] map ; + length [ 0 ] map + ] keep [ append ] 2map ; : diagonal/ ( -- matrix ) horizontal reverse pad-front pad-back flip ; @@ -98,9 +98,6 @@ PRIVATE> [ call 4 max-product , ] each ] { } make supremum ; -! TODO: solution works but doesn't completely compile due to the creation of -! the diagonal matrices, there must be a cleaner way to generate those - ! [ euler011 ] 100 ave-time ! 4 ms run / 0 ms GC ave time - 100 trials From 724eff0089c3f47ce1d819b37df10a15a7e462da Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 31 Dec 2007 00:28:11 +0100 Subject: [PATCH 5/7] Use group to do the grouping to be closer to the original problem --- extra/project-euler/011/011.factor | 44 +++++++++++++++--------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/extra/project-euler/011/011.factor b/extra/project-euler/011/011.factor index 7520fb9182..322c361ee0 100644 --- a/extra/project-euler/011/011.factor +++ b/extra/project-euler/011/011.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces project-euler.common sequences ; +USING: kernel namespaces project-euler.common sequences splitting ; IN: project-euler.011 ! http://projecteuler.net/index.php?section=problems&id=11 @@ -45,27 +45,27 @@ IN: project-euler.011 : horizontal ( -- matrix ) { - { 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 } - { 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 } - { 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 } - { 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 } - { 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 } - { 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 } - { 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 } - { 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 } - { 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 } - { 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 } - { 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 } - { 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 } - { 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 } - { 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 } - { 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 } - { 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 } - { 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 } - { 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 } - { 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 } - { 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 } - } ; + 08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 + 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 + 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 + 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 + 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 + 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 + 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 + 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 + 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 + 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 + 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 + 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 + 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 + 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 + 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 + 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 + 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 + 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 + 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 + 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48 + } 20 group ; : vertical ( -- matrix ) horizontal flip ; From cf19d8a37cef0c510381c066b376315bd96e2611 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 31 Dec 2007 02:59:53 +0100 Subject: [PATCH 6/7] Factor solution to project Euler problem 173 --- extra/project-euler/173/173.factor | 34 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 2 +- 2 files changed, 35 insertions(+), 1 deletion(-) create mode 100644 extra/project-euler/173/173.factor diff --git a/extra/project-euler/173/173.factor b/extra/project-euler/173/173.factor new file mode 100644 index 0000000000..4eef3ec3e2 --- /dev/null +++ b/extra/project-euler/173/173.factor @@ -0,0 +1,34 @@ +! Copyright (c) 2007 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.functions math.ranges sequences ; +IN: project-euler.173 + +! http://projecteuler.net/index.php?section=problems&id=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] + +! 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? + +! SOLUTION +! -------- + +: laminaes ( upper -- n ) + 4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ; + +: euler173 ( -- answer ) + 1000000 laminaes ; + +! [ euler173 ] 100 ave-time +! 0 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler173 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index f256f03138..68c71da049 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -10,7 +10,7 @@ USING: definitions io io.files kernel math math.parser sequences strings project-euler.067 project-euler.134 project-euler.169 - project-euler.175 ; + project-euler.173 project-euler.175 ; IN: project-euler Date: Thu, 3 Jan 2008 11:52:46 +0100 Subject: [PATCH 7/7] Use cut-slice instead of cut in a loop --- extra/project-euler/018/018.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/project-euler/018/018.factor b/extra/project-euler/018/018.factor index bc3bf56c86..b43ff5234f 100644 --- a/extra/project-euler/018/018.factor +++ b/extra/project-euler/018/018.factor @@ -68,7 +68,7 @@ IN: project-euler.018 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-slice swap ] map nip ; PRIVATE>