From ffed0d7ebae20603c9170438f47436cef07b2a5d Mon Sep 17 00:00:00 2001
From: Guillaume Nargeot <killy971@gmail.com>
Date: Sat, 5 Sep 2009 10:59:04 +0900
Subject: [PATCH] Solution to Project Euler problem 85

---
 extra/project-euler/085/085-tests.factor |  4 ++
 extra/project-euler/085/085.factor       | 57 ++++++++++++++++++++++++
 extra/project-euler/authors.txt          |  1 +
 extra/project-euler/project-euler.factor | 10 ++---
 4 files changed, 67 insertions(+), 5 deletions(-)
 create mode 100644 extra/project-euler/085/085-tests.factor
 create mode 100644 extra/project-euler/085/085.factor

diff --git a/extra/project-euler/085/085-tests.factor b/extra/project-euler/085/085-tests.factor
new file mode 100644
index 0000000000..2dadf6a454
--- /dev/null
+++ b/extra/project-euler/085/085-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.085 tools.test ;
+IN: project-euler.085.tests
+
+[ 2772 ] [ euler085 ] unit-test
diff --git a/extra/project-euler/085/085.factor b/extra/project-euler/085/085.factor
new file mode 100644
index 0000000000..bd09203da5
--- /dev/null
+++ b/extra/project-euler/085/085.factor
@@ -0,0 +1,57 @@
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math math.ranges project-euler.common sequences ;
+IN: project-euler.085
+
+! http://projecteuler.net/index.php?section=problems&id=85
+
+! DESCRIPTION
+! -----------
+
+! By counting carefully it can be seen that a rectangular grid measuring
+! 3 by 2 contains eighteen rectangles.
+
+! Although there exists no rectangular grid that contains exactly two million
+! rectangles, find the area of the grid with the nearest solution.
+
+
+! SOLUTION
+! --------
+
+! A grid measuring x by y contains x * (x + 1) * y * (x + 1) rectangles.
+
+<PRIVATE
+
+: distance ( m -- n )
+    2000000 - abs ;
+
+: rectangles-count ( a b -- n )
+    2dup [ 1 + ] bi@ * * * 4 / ;
+
+: unique-products ( a b -- seq )
+    tuck [a,b] [
+        over dupd [a,b] [ 2array ] with map
+    ] map concat nip ;
+
+: max-by-last ( seq seq -- seq )
+    [ [ last ] bi@ < ] most ;
+
+: array2 ( seq -- a b )
+    [ first ] [ last ] bi ;
+
+: convert ( seq -- seq )
+    array2 [ * ] [ rectangles-count distance ] 2bi 2array ;
+
+: area-of-nearest ( -- n )
+    1 2000 unique-products
+    [ convert ] [ max-by-last ] map-reduce first ;
+
+PRIVATE>
+
+: euler085 ( -- answer )
+    area-of-nearest ;
+
+! [ euler085 ] 100 ave-time
+! 2285 ms ave run time - 4.8 SD (100 trials)
+
+SOLUTION: euler085
diff --git a/extra/project-euler/authors.txt b/extra/project-euler/authors.txt
index d280bffce6..50d93f6552 100644
--- a/extra/project-euler/authors.txt
+++ b/extra/project-euler/authors.txt
@@ -1,2 +1,3 @@
 Aaron Schaefer
 Eric Mertens
+Guillaume Nargeot
diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor
index 95d3644215..d925e2253d 100644
--- a/extra/project-euler/project-euler.factor
+++ b/extra/project-euler/project-euler.factor
@@ -18,11 +18,11 @@ USING: definitions io io.files io.pathnames kernel math math.parser
     project-euler.055 project-euler.056 project-euler.057 project-euler.058
     project-euler.059 project-euler.063 project-euler.067 project-euler.069
     project-euler.071 project-euler.073 project-euler.075 project-euler.076
-    project-euler.079 project-euler.092 project-euler.097 project-euler.099
-    project-euler.100 project-euler.116 project-euler.117 project-euler.134
-    project-euler.148 project-euler.150 project-euler.151 project-euler.164
-    project-euler.169 project-euler.173 project-euler.175 project-euler.186
-    project-euler.190 project-euler.203 project-euler.215 ;
+    project-euler.079 project-euler.085 project-euler.092 project-euler.097
+    project-euler.099 project-euler.100 project-euler.116 project-euler.117
+    project-euler.134 project-euler.148 project-euler.150 project-euler.151
+    project-euler.164 project-euler.169 project-euler.173 project-euler.175
+    project-euler.186 project-euler.190 project-euler.203 project-euler.215 ;
 IN: project-euler
 
 <PRIVATE