extra/project-euler/085/085.factor

   1 ! Copyright (c) 2009 Guillaume Nargeot.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel math ranges project-euler.common
   4 sequences ;
   5 IN: project-euler.085
   6
   7 ! https://projecteuler.net/problem=85
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! By counting carefully it can be seen that a rectangular grid
  13 ! measuring 3 by 2 contains eighteen rectangles.
  14
  15 ! Although there exists no rectangular grid that contains
  16 ! exactly two million rectangles, find the area of the grid with
  17 ! the nearest solution.
  18
  19
  20 ! SOLUTION
  21 ! --------
  22
  23 ! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4
  24 ! rectangles.
  25
  26 <PRIVATE
  27
  28 : distance ( m -- n )
  29     2000000 - abs ; inline
  30
  31 : rectangles-count ( a b -- n )
  32     2dup [ 1 + ] bi@ * * * 4 /i ; inline
  33
  34 :: each-unique-product ( ... a b quot: ( ... i j -- ... ) -- ... )
  35     a b [a..b] [| i |
  36         i b [a..b] [| j |
  37             i j quot call
  38         ] each
  39     ] each ; inline
  40
  41 TUPLE: result { area read-only } { distance read-only } ;
  42
  43 C: <result> result
  44
  45 : min-by-distance ( seq seq -- seq )
  46     [ [ distance>> ] bi@ < ] most ; inline
  47
  48 : compute-result ( i j -- pair )
  49     [ * ] [ rectangles-count distance ] 2bi <result> ; inline
  50
  51 : area-of-nearest ( -- n )
  52     T{ result f 0 2000000 } 1 2000
  53     [ compute-result min-by-distance ] each-unique-product area>> ;
  54
  55 PRIVATE>
  56
  57 : euler085 ( -- answer )
  58     area-of-nearest ;
  59
  60 ! [ euler085 ] 100 ave-time
  61 ! 791 ms ave run time - 17.15 SD (100 trials)
  62
  63 SOLUTION: euler085