/extra/project-euler/085/085.factor

http://github.com/abeaumont/factor · Factor · 61 lines · 27 code · 20 blank · 14 comment · 0 complexity · 188409cfa061dfb4751e84ffb2f497a3 MD5 · raw file

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