79 lines
2.2 KiB
Factor
79 lines
2.2 KiB
Factor
! 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 total number
|
|
! of indexes that are equal to one.
|
|
|
|
SYMBOL: p-count
|
|
|
|
<PRIVATE
|
|
|
|
: max-p ( -- n )
|
|
p-count get length ;
|
|
|
|
: adjust-p-count ( n -- )
|
|
max-p 1- over <range> 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 <array> 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
|