extra/project-euler/039/039.factor

   1 ! Copyright (c) 2008 Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.ranges
   4     namespaces project-euler.common sequences ;
   5 IN: project-euler.039
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=39
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! If p is the perimeter of a right angle triangle with integral length sides,
  13 ! {a,b,c}, there are exactly three solutions for p = 120.
  14
  15 !     {20,48,52}, {24,45,51}, {30,40,50}
  16
  17 ! For which value of p < 1000, is the number of solutions maximised?
  18
  19
  20 ! SOLUTION
  21 ! --------
  22
  23 ! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html
  24 ! Identical implementation as problem #75
  25
  26 ! Basically, this makes an array of 1000 zeros, recursively creates primitive
  27 ! triples using the three transforms and then increments the array at index
  28 ! [a+b+c] by one for each triple's sum AND its multiples under 1000 (to account
  29 ! for non-primitive triples). The answer is just the index that has the highest
  30 ! number.
  31
  32 SYMBOL: p-count
  33
  34 <PRIVATE
  35
  36 : max-p ( -- n )
  37     p-count get length ;
  38
  39 : adjust-p-count ( n -- )
  40     max-p 1- over <range> p-count get
  41     [ [ 1+ ] change-nth ] curry each ;
  42
  43 : (count-perimeters) ( seq -- )
  44     dup sum max-p < [
  45         dup sum adjust-p-count
  46         [ u-transform ] [ a-transform ] [ d-transform ] tri
  47         [ (count-perimeters) ] tri@
  48     ] [
  49         drop
  50     ] if ;
  51
  52 : count-perimeters ( n -- )
  53     0 <array> p-count set { 3 4 5 } (count-perimeters) ;
  54
  55 PRIVATE>
  56
  57 : euler039 ( -- answer )
  58     [
  59         1000 count-perimeters p-count get [ supremum ] keep index
  60     ] with-scope ;
  61
  62 ! [ euler039 ] 100 ave-time
  63 ! 1 ms ave run time - 0.37 SD (100 trials)
  64
  65 MAIN: euler039