extra/project-euler/039/039.factor

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