From 6394eb70bf82005eff70258aa91f133eea7ef10c Mon Sep 17 00:00:00 2001 From: Aaron Schaefer Date: Wed, 30 Jan 2008 00:50:18 -0500 Subject: [PATCH 1/5] Solution to Project Euler problem 37 --- extra/project-euler/037/037.factor | 52 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 4 +- 2 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 extra/project-euler/037/037.factor diff --git a/extra/project-euler/037/037.factor b/extra/project-euler/037/037.factor new file mode 100644 index 0000000000..f2d5d17c4d --- /dev/null +++ b/extra/project-euler/037/037.factor @@ -0,0 +1,52 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.parser math.primes sequences ; +IN: project-euler.037 + +! http://projecteuler.net/index.php?section=problems&id=37 + +! DESCRIPTION +! ----------- + +! The number 3797 has an interesting property. Being prime itself, it is +! possible to continuously remove digits from left to right, and remain prime +! at each stage: 3797, 797, 97, and 7. Similarly we can work from right to +! left: 3797, 379, 37, and 3. + +! Find the sum of the only eleven primes that are both truncatable from left to +! right and right to left. + +! NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes. + + +! SOLUTION +! -------- + + [ + dup prime? [ r-trunc? ] [ drop f ] if + ] [ + drop t + ] if ; + +: reverse-digits ( n -- m ) + number>string reverse 10 string>integer ; + +: l-trunc? ( n -- ? ) + reverse-digits 10 /i reverse-digits dup 0 > [ + dup prime? [ l-trunc? ] [ drop f ] if + ] [ + drop t + ] if ; + +PRIVATE> + +: euler037 ( -- answer ) + 23 1000000 primes-between [ r-trunc? ] subset [ l-trunc? ] subset sum ; + +! [ euler037 ] 100 ave-time +! 768 ms run / 9 ms GC ave time - 100 trials + +MAIN: euler037 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index feef9dbfa8..fbb62961a9 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -11,8 +11,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs project-euler.025 project-euler.026 project-euler.027 project-euler.028 project-euler.029 project-euler.030 project-euler.031 project-euler.032 project-euler.033 project-euler.034 project-euler.035 project-euler.036 - project-euler.067 project-euler.134 project-euler.169 project-euler.173 - project-euler.175 ; + project-euler.037 project-euler.067 project-euler.134 project-euler.169 + project-euler.173 project-euler.175 ; IN: project-euler Date: Fri, 1 Feb 2008 14:45:29 -0500 Subject: [PATCH 2/5] Solution to Project Euler problem 38 --- extra/project-euler/032/032.factor | 5 +-- extra/project-euler/038/038.factor | 55 ++++++++++++++++++++++++ extra/project-euler/common/common.factor | 6 ++- extra/project-euler/project-euler.factor | 4 +- 4 files changed, 63 insertions(+), 7 deletions(-) create mode 100644 extra/project-euler/038/038.factor diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor index d10326a076..2baa6f8714 100644 --- a/extra/project-euler/032/032.factor +++ b/extra/project-euler/032/032.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib hashtables kernel math math.combinatorics math.parser - math.ranges project-euler.common sequences sorting ; + math.ranges project-euler.common sequences ; IN: project-euler.032 ! http://projecteuler.net/index.php?section=problems&id=32 @@ -63,9 +63,6 @@ PRIVATE> : source-032a ( -- seq ) 50 [1,b] 2000 [1,b] cartesian-product ; -: pandigital? ( n -- ? ) - number>string natural-sort "123456789" = ; - ! multiplicand/multiplier/product : mmp ( pair -- n ) first2 2dup * [ number>string ] 3apply 3append 10 string>integer ; diff --git a/extra/project-euler/038/038.factor b/extra/project-euler/038/038.factor new file mode 100644 index 0000000000..cbe6f2363c --- /dev/null +++ b/extra/project-euler/038/038.factor @@ -0,0 +1,55 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.parser math.ranges project-euler.common sequences ; +IN: project-euler.038 + +! http://projecteuler.net/index.php?section=problems&id=38 + +! DESCRIPTION +! ----------- + +! Take the number 192 and multiply it by each of 1, 2, and 3: + +! 192 × 1 = 192 +! 192 × 2 = 384 +! 192 × 3 = 576 + +! By concatenating each product we get the 1 to 9 pandigital, 192384576. We +! will call 192384576 the concatenated product of 192 and (1,2,3) + +! The same can be achieved by starting with 9 and multiplying by 1, 2, 3, 4, +! and 5, giving the pandigital, 918273645, which is the concatenated product of +! 9 and (1,2,3,4,5). + +! What is the largest 1 to 9 pandigital 9-digit number that can be formed as +! the concatenated product of an integer with (1,2, ... , n) where n > 1? + + +! SOLUTION +! -------- + +! Only need to search 4-digit numbers starting with 9 since a 2-digit number +! starting with 9 would produce 8 or 11 digits, and a 3-digit number starting +! with 9 would produce 7 or 11 digits. + + [ + 2drop 10 swap digits>integer + ] [ + [ * number>digits over push-all ] 2keep 1+ (concat-product) + ] if ; + +: concat-product ( n -- m ) + V{ } clone swap 1 (concat-product) ; + +PRIVATE> + +: euler038 ( -- answer ) + 9123 9876 [a,b] [ concat-product ] map [ pandigital? ] subset supremum ; + +! [ euler038 ] 100 ave-time +! 37 ms run / 1 ms GC ave time - 100 trials + +MAIN: euler038 diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 2e718ab5a2..609492c724 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -1,5 +1,5 @@ USING: arrays combinators.lib kernel math math.functions math.miller-rabin - math.parser math.primes.factors math.ranges namespaces sequences ; + math.parser math.primes.factors math.ranges namespaces sequences sorting ; IN: project-euler.common ! A collection of words used by more than one Project Euler solution @@ -12,6 +12,7 @@ IN: project-euler.common ! log10 - #25, #134 ! max-path - #18, #67 ! number>digits - #16, #20, #30, #34 +! pandigital? - #32, #38 ! propagate-all - #18, #67 ! sum-proper-divisors - #21 ! tau* - #12 @@ -67,6 +68,9 @@ PRIVATE> : number>digits ( n -- seq ) number>string string>digits ; +: pandigital? ( n -- ? ) + number>string natural-sort "123456789" = ; + ! Not strictly needed, but it is nice to be able to dump the triangle after the ! propagation : propagate-all ( triangle -- newtriangle ) diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index fbb62961a9..0037e4462f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -11,8 +11,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs project-euler.025 project-euler.026 project-euler.027 project-euler.028 project-euler.029 project-euler.030 project-euler.031 project-euler.032 project-euler.033 project-euler.034 project-euler.035 project-euler.036 - project-euler.037 project-euler.067 project-euler.134 project-euler.169 - project-euler.173 project-euler.175 ; + project-euler.037 project-euler.038 project-euler.067 project-euler.134 + project-euler.169 project-euler.173 project-euler.175 ; IN: project-euler Date: Sat, 2 Feb 2008 13:37:53 -0500 Subject: [PATCH 3/5] Solution to Project Euler problem 39 --- extra/project-euler/039/039.factor | 76 ++++++++++++++++++++++++ extra/project-euler/project-euler.factor | 8 +-- 2 files changed, 80 insertions(+), 4 deletions(-) create mode 100644 extra/project-euler/039/039.factor diff --git a/extra/project-euler/039/039.factor b/extra/project-euler/039/039.factor new file mode 100644 index 0000000000..4df7ba610a --- /dev/null +++ b/extra/project-euler/039/039.factor @@ -0,0 +1,76 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators.lib kernel math math.matrices math.ranges namespaces + sequences ; +IN: project-euler.039 + +! http://projecteuler.net/index.php?section=problems&id=39 + +! DESCRIPTION +! ----------- + +! If p is the perimeter of a right angle triangle with integral length sides, +! {a,b,c}, there are exactly three solutions for p = 120. + +! {20,48,52}, {24,45,51}, {30,40,50} + +! For which value of p < 1000, is the number of solutions maximised? + + +! SOLUTION +! -------- + +! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html + +! Basically, this makes an array of 1000 zeros, recursively creates primitive +! triples using the three transforms and then increments the array at index +! [a+b+c] by one for each triple's sum AND its multiples under 1000 (to account +! for non-primitive triples). The answer is just the index that has the highest +! number. + +SYMBOL: p-count + + p-count get + [ [ 1+ ] change-nth ] curry each ; + +: transform ( triple matrix -- new-triple ) + [ 1array ] dip m. first ; + +: u-transform ( triple -- new-triple ) + { { 1 2 2 } { -2 -1 -2 } { 2 2 3 } } transform ; + +: a-transform ( triple -- new-triple ) + { { 1 2 2 } { 2 1 2 } { 2 2 3 } } transform ; + +: d-transform ( triple -- new-triple ) + { { -1 -2 -2 } { 2 1 2 } { 2 2 3 } } transform ; + +: (count-perimeters) ( seq -- ) + dup sum max-p < [ + dup sum adjust-p-count + [ u-transform ] keep [ a-transform ] keep d-transform + [ (count-perimeters) ] 3apply + ] [ + drop + ] if ; + +: count-perimeters ( n -- ) + 0 p-count set { 3 4 5 } (count-perimeters) ; + +PRIVATE> + +: euler039 ( -- answer ) + [ + 1000 count-perimeters p-count get [ supremum ] keep index + ] with-scope ; + +! [ euler039 ] 100 ave-time +! 2 ms run / 0 ms GC ave time - 100 trials + +MAIN: euler039 diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 0037e4462f..86dff7a192 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu. ! 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 math +USING: definitions io io.files kernel math math.parser project-euler.ave-time + sequences 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 project-euler.009 project-euler.010 project-euler.011 project-euler.012 @@ -11,8 +11,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs project-euler.025 project-euler.026 project-euler.027 project-euler.028 project-euler.029 project-euler.030 project-euler.031 project-euler.032 project-euler.033 project-euler.034 project-euler.035 project-euler.036 - project-euler.037 project-euler.038 project-euler.067 project-euler.134 - project-euler.169 project-euler.173 project-euler.175 ; + project-euler.037 project-euler.038 project-euler.039 project-euler.067 + project-euler.134 project-euler.169 project-euler.173 project-euler.175 ; IN: project-euler Date: Sat, 2 Feb 2008 17:22:20 -0500 Subject: [PATCH 4/5] Solution to Project Euler problem 75 --- extra/project-euler/039/039.factor | 17 +----- extra/project-euler/075/075.factor | 78 ++++++++++++++++++++++++ extra/project-euler/common/common.factor | 16 ++++- extra/project-euler/project-euler.factor | 3 +- 4 files changed, 98 insertions(+), 16 deletions(-) create mode 100644 extra/project-euler/075/075.factor diff --git a/extra/project-euler/039/039.factor b/extra/project-euler/039/039.factor index 4df7ba610a..67578dc5f2 100644 --- a/extra/project-euler/039/039.factor +++ b/extra/project-euler/039/039.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib kernel math math.matrices math.ranges namespaces - sequences ; +USING: arrays combinators.lib kernel math math.ranges namespaces + project-euler.common sequences ; IN: project-euler.039 ! http://projecteuler.net/index.php?section=problems&id=39 @@ -21,6 +21,7 @@ IN: project-euler.039 ! -------- ! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html +! Identical implementation as problem #75 ! Basically, this makes an array of 1000 zeros, recursively creates primitive ! triples using the three transforms and then increments the array at index @@ -39,18 +40,6 @@ SYMBOL: p-count max-p 1- over p-count get [ [ 1+ ] change-nth ] curry each ; -: transform ( triple matrix -- new-triple ) - [ 1array ] dip m. first ; - -: u-transform ( triple -- new-triple ) - { { 1 2 2 } { -2 -1 -2 } { 2 2 3 } } transform ; - -: a-transform ( triple -- new-triple ) - { { 1 2 2 } { 2 1 2 } { 2 2 3 } } transform ; - -: d-transform ( triple -- new-triple ) - { { -1 -2 -2 } { 2 1 2 } { 2 2 3 } } transform ; - : (count-perimeters) ( seq -- ) dup sum max-p < [ dup sum adjust-p-count diff --git a/extra/project-euler/075/075.factor b/extra/project-euler/075/075.factor new file mode 100644 index 0000000000..f8ee9d50db --- /dev/null +++ b/extra/project-euler/075/075.factor @@ -0,0 +1,78 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays combinators.lib kernel math math.ranges namespaces + project-euler.common sequences ; +IN: project-euler.075 + +! http://projecteuler.net/index.php?section=problems&id=75 + +! DESCRIPTION +! ----------- + +! It turns out that 12 cm is the smallest length of wire can be bent to form a +! right angle triangle in exactly one way, but there are many more examples. + +! 12 cm: (3,4,5) +! 24 cm: (6,8,10) +! 30 cm: (5,12,13) +! 36 cm: (9,12,15) +! 40 cm: (8,15,17) +! 48 cm: (12,16,20) + +! In contrast, some lengths of wire, like 20 cm, cannot be bent to form a right +! angle triangle, and other lengths allow more than one solution to be found; +! for example, using 120 cm it is possible to form exactly three different +! right angle triangles. + +! 120 cm: (30,40,50), (20,48,52), (24,45,51) + +! Given that L is the length of the wire, for how many values of L ≤ 1,000,000 +! can exactly one right angle triangle be formed? + + +! SOLUTION +! -------- + +! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html +! Identical implementation as problem #39 + +! Basically, this makes an array of 1000000 zeros, recursively creates +! primitive triples using the three transforms and then increments the array at +! index [a+b+c] by one for each triple's sum AND its multiples under 1000000 +! (to account for non-primitive triples). The answer is just the number of +! indexes that equal one. + +SYMBOL: p-count + + p-count get + [ [ 1+ ] change-nth ] curry each ; + +: (count-perimeters) ( seq -- ) + dup sum max-p < [ + dup sum adjust-p-count + [ u-transform ] keep [ a-transform ] keep d-transform + [ (count-perimeters) ] 3apply + ] [ + drop + ] if ; + +: count-perimeters ( n -- ) + 0 p-count set { 3 4 5 } (count-perimeters) ; + +PRIVATE> + +: euler075 ( -- answer ) + [ + 1000000 count-perimeters p-count get [ 1 = ] count + ] with-scope ; + +! [ euler075 ] 100 ave-time +! 1873 ms run / 123 ms GC ave time - 100 trials + +MAIN: euler075 diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index 609492c724..50adbe4953 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -1,5 +1,6 @@ USING: arrays combinators.lib kernel math math.functions math.miller-rabin - math.parser math.primes.factors math.ranges namespaces sequences sorting ; + math.matrices math.parser math.primes.factors math.ranges namespaces + sequences sorting ; IN: project-euler.common ! A collection of words used by more than one Project Euler solution @@ -16,6 +17,7 @@ IN: project-euler.common ! propagate-all - #18, #67 ! sum-proper-divisors - #21 ! tau* - #12 +! [uad]-transform - #39, #75 : nth-pair ( n seq -- nth next ) @@ -45,6 +47,9 @@ IN: project-euler.common dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if ] { } make sum ; +: transform ( triple matrix -- new-triple ) + [ 1array ] dip m. first ; + PRIVATE> : cartesian-product ( seq1 seq2 -- seq1xseq2 ) @@ -101,3 +106,12 @@ PRIVATE> dup sqrt >fixnum [1,b] [ dupd mod zero? [ [ 2 + ] dip ] when ] each drop * ; + +! These transforms are for generating primitive Pythagorean triples +: u-transform ( triple -- new-triple ) + { { 1 2 2 } { -2 -1 -2 } { 2 2 3 } } transform ; +: a-transform ( triple -- new-triple ) + { { 1 2 2 } { 2 1 2 } { 2 2 3 } } transform ; +: d-transform ( triple -- new-triple ) + { { -1 -2 -2 } { 2 1 2 } { 2 2 3 } } transform ; + diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 86dff7a192..f5766536ef 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -12,7 +12,8 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time project-euler.029 project-euler.030 project-euler.031 project-euler.032 project-euler.033 project-euler.034 project-euler.035 project-euler.036 project-euler.037 project-euler.038 project-euler.039 project-euler.067 - project-euler.134 project-euler.169 project-euler.173 project-euler.175 ; + project-euler.075 project-euler.134 project-euler.169 project-euler.173 + project-euler.175 ; IN: project-euler Date: Sat, 2 Feb 2008 18:53:32 -0500 Subject: [PATCH 5/5] Solution to Project Euler problem 40 --- extra/project-euler/040/040.factor | 51 ++++++++++++++++++++++++ extra/project-euler/075/075.factor | 4 +- extra/project-euler/project-euler.factor | 6 +-- 3 files changed, 56 insertions(+), 5 deletions(-) create mode 100644 extra/project-euler/040/040.factor diff --git a/extra/project-euler/040/040.factor b/extra/project-euler/040/040.factor new file mode 100644 index 0000000000..8984559265 --- /dev/null +++ b/extra/project-euler/040/040.factor @@ -0,0 +1,51 @@ +! Copyright (c) 2008 Aaron Schaefer. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math math.parser sequences strings ; +IN: project-euler.040 + +! http://projecteuler.net/index.php?section=problems&id=40 + +! DESCRIPTION +! ----------- + +! An irrational decimal fraction is created by concatenating the positive +! integers: + +! 0.123456789101112131415161718192021... + +! It can be seen that the 12th digit of the fractional part is 1. + +! If dn represents the nth digit of the fractional part, find the value of the +! following expression. + +! d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000 + + +! SOLUTION +! -------- + + [ + pick number>string over push-all rot 1+ -rot (concat-upto) + ] [ + 2nip + ] if ; + +: concat-upto ( n -- str ) + SBUF" " clone 1 -rot (concat-upto) ; + +: nth-integer ( n str -- m ) + [ 1- ] dip nth 1string 10 string>integer ; + +PRIVATE> + +: euler040 ( -- answer ) + 1000000 concat-upto { 1 10 100 1000 10000 100000 1000000 } + [ swap nth-integer ] with map product ; + +! [ euler040 ] 100 ave-time +! 1002 ms run / 43 ms GC ave time - 100 trials + +MAIN: euler040 diff --git a/extra/project-euler/075/075.factor b/extra/project-euler/075/075.factor index f8ee9d50db..8399235c0d 100644 --- a/extra/project-euler/075/075.factor +++ b/extra/project-euler/075/075.factor @@ -39,8 +39,8 @@ IN: project-euler.075 ! Basically, this makes an array of 1000000 zeros, recursively creates ! primitive triples using the three transforms and then increments the array at ! index [a+b+c] by one for each triple's sum AND its multiples under 1000000 -! (to account for non-primitive triples). The answer is just the number of -! indexes that equal one. +! (to account for non-primitive triples). The answer is just the total number +! of indexes that are equal to one. SYMBOL: p-count diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index f5766536ef..eb9d7d1300 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -11,9 +11,9 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time project-euler.025 project-euler.026 project-euler.027 project-euler.028 project-euler.029 project-euler.030 project-euler.031 project-euler.032 project-euler.033 project-euler.034 project-euler.035 project-euler.036 - project-euler.037 project-euler.038 project-euler.039 project-euler.067 - project-euler.075 project-euler.134 project-euler.169 project-euler.173 - project-euler.175 ; + project-euler.037 project-euler.038 project-euler.039 project-euler.040 + project-euler.067 project-euler.075 project-euler.134 project-euler.169 + project-euler.173 project-euler.175 ; IN: project-euler