extra/project-euler/075/075.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 ;
   5 IN: project-euler.075
   6
   7 ! https://projecteuler.net/problem=75
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! It turns out that 12 cm is the smallest length of wire can be
  13 ! bent to form a right angle triangle in exactly one way, but
  14 ! there are many more examples.
  15
  16 !     12 cm: (3,4,5)
  17 !     24 cm: (6,8,10)
  18 !     30 cm: (5,12,13)
  19 !     36 cm: (9,12,15)
  20 !     40 cm: (8,15,17)
  21 !     48 cm: (12,16,20)
  22
  23 ! In contrast, some lengths of wire, like 20 cm, cannot be bent
  24 ! to form a right angle triangle, and other lengths allow more
  25 ! than one solution to be found; for example, using 120 cm it is
  26 ! possible to form exactly three different right angle
  27 ! triangles.
  28
  29 !     120 cm: (30,40,50), (20,48,52), (24,45,51)
  30
  31 ! Given that L is the length of the wire, for how many values of
  32 ! L ≤ 2,000,000 can exactly one right angle triangle be formed?
  33
  34
  35 ! SOLUTION
  36 ! --------
  37
  38 ! Algorithm adapted from
  39 ! https://mathworld.wolfram.com/PythagoreanTriple.html
  40 ! Identical implementation as problem #39
  41
  42 ! Basically, this makes an array of 2000000 zeros, recursively
  43 ! creates primitive triples using the three transforms and then
  44 ! increments the array at index [a+b+c] by one for each triple's
  45 ! sum AND its multiples under 2000000 (to account for
  46 ! non-primitive triples). The answer is just the total number of
  47 ! indexes that are equal to one.
  48
  49 SYMBOL: p-count
  50
  51 <PRIVATE
  52
  53 : max-p ( -- n )
  54     p-count get length ;
  55
  56 : adjust-p-count ( n -- )
  57     max-p 1 - over <range> p-count get
  58     [ [ 1 + ] change-nth ] curry each ;
  59
  60 : (count-perimeters) ( seq -- )
  61     dup sum max-p < [
  62         dup sum adjust-p-count
  63         [ u-transform ] [ a-transform ] [ d-transform ] tri
  64         [ (count-perimeters) ] tri@
  65     ] [
  66         drop
  67     ] if ;
  68
  69 : count-perimeters ( n -- )
  70     0 <array> p-count set { 3 4 5 } (count-perimeters) ;
  71
  72 PRIVATE>
  73
  74 : euler075 ( -- answer )
  75     [
  76         2000000 count-perimeters p-count get [ 1 = ] count
  77     ] with-scope ;
  78
  79 ! [ euler075 ] 10 ave-time
  80 ! 3341 ms ave run timen - 157.77 SD (10 trials)
  81
  82 SOLUTION: euler075