extra/project-euler/085/085.factor

   1 ! Copyright (c) 2009 Guillaume Nargeot.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.ranges project-euler.common sequences ;
   4 IN: project-euler.085
   5
   6 ! http://projecteuler.net/index.php?section=problems&id=85
   7
   8 ! DESCRIPTION
   9 ! -----------
  10
  11 ! By counting carefully it can be seen that a rectangular grid measuring
  12 ! 3 by 2 contains eighteen rectangles.
  13
  14 ! Although there exists no rectangular grid that contains exactly two million
  15 ! rectangles, find the area of the grid with the nearest solution.
  16
  17
  18 ! SOLUTION
  19 ! --------
  20
  21 ! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles.
  22
  23 <PRIVATE
  24
  25 : distance ( m -- n )
  26     2000000 - abs ;
  27
  28 : rectangles-count ( a b -- n )
  29     2dup [ 1 + ] bi@ * * * 4 / ;
  30
  31 : unique-products ( a b -- seq )
  32     tuck [a,b] [
  33         over dupd [a,b] [ 2array ] with map
  34     ] map concat nip ;
  35
  36 : max-by-last ( seq seq -- seq )
  37     [ [ last ] bi@ < ] most ;
  38
  39 : array2 ( seq -- a b )
  40     [ first ] [ last ] bi ;
  41
  42 : convert ( seq -- seq )
  43     array2 [ * ] [ rectangles-count distance ] 2bi 2array ;
  44
  45 : area-of-nearest ( -- n )
  46     1 2000 unique-products
  47     [ convert ] [ max-by-last ] map-reduce first ;
  48
  49 PRIVATE>
  50
  51 : euler085 ( -- answer )
  52     area-of-nearest ;
  53
  54 ! [ euler085 ] 100 ave-time
  55 ! 2285 ms ave run time - 4.8 SD (100 trials)
  56
  57 SOLUTION: euler085