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