diff --git a/extra/project-euler/011/011.factor b/extra/project-euler/011/011.factor index 9739ee971c..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,40 +45,40 @@ 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 ; : 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 diff --git a/extra/project-euler/018/018.factor b/extra/project-euler/018/018.factor index 3390844898..2dc05db1b1 100644 --- a/extra/project-euler/018/018.factor +++ b/extra/project-euler/018/018.factor @@ -51,24 +51,24 @@ IN: project-euler.018 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/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/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 a6dc9bd467..250a92b953 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: definitions io io.files kernel math.parser sequences vocabs - vocabs.loader project-euler.ave-time project-euler.common + vocabs.loader project-euler.ave-time project-euler.common math project-euler.001 project-euler.002 project-euler.003 project-euler.004 project-euler.005 project-euler.006 project-euler.007 project-euler.008 project-euler.009 project-euler.010 project-euler.011 project-euler.012 @@ -31,7 +31,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