extra/project-euler/085/085.factor

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