PageRenderTime 62ms CodeModel.GetById 51ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 0ms

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

http://github.com/abeaumont/factor
Unknown | 61 lines | 41 code | 20 blank | 0 comment | 0 complexity | 188409cfa061dfb4751e84ffb2f497a3 MD5 | raw file
 1! Copyright (c) 2009 Guillaume Nargeot.
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: accessors kernel math math.ranges project-euler.common
 4sequences locals ;
 5IN: 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
39TUPLE: result { area read-only } { distance read-only } ;
40
41C: <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
53PRIVATE>
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
61SOLUTION: euler085