From b04bc4d866883cc0864dae4cfdc435e1c5586e12 Mon Sep 17 00:00:00 2001
From: Aaron Schaefer <aaron@elasticdog.com>
Date: Mon, 10 Nov 2008 00:58:43 -0500
Subject: [PATCH] Solution to Project Euler problem 71

---
 extra/project-euler/071/071-tests.factor |  4 ++
 extra/project-euler/071/071.factor       | 52 ++++++++++++++++++++++++
 2 files changed, 56 insertions(+)
 create mode 100644 extra/project-euler/071/071-tests.factor
 create mode 100644 extra/project-euler/071/071.factor

diff --git a/extra/project-euler/071/071-tests.factor b/extra/project-euler/071/071-tests.factor
new file mode 100644
index 0000000000..ba61d7640b
--- /dev/null
+++ b/extra/project-euler/071/071-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.071 tools.test ;
+IN: project-euler.071.tests
+
+[ 428570 ] [ euler071 ] unit-test
diff --git a/extra/project-euler/071/071.factor b/extra/project-euler/071/071.factor
new file mode 100644
index 0000000000..1fc08c3548
--- /dev/null
+++ b/extra/project-euler/071/071.factor
@@ -0,0 +1,52 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.ratios sequences ;
+IN: project-euler.071
+
+! http://projecteuler.net/index.php?section=problems&id=71
+
+! DESCRIPTION
+! -----------
+
+! Consider the fraction, n/d, where n and d are positive integers. If n<d and
+! HCF(n,d) = 1, it is called a reduced proper fraction.
+
+! If we list the set of reduced proper fractions for d <= 8 in ascending order of
+! size, we get:
+
+!     1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8,
+!     2/3, 5/7, 3/4, 4/5, 5/6, 6/7, 7/8
+
+! It can be seen that 2/5 is the fraction immediately to the left of 3/7.
+
+! By listing the set of reduced proper fractions for d <= 1,000,000 in
+! ascending order of size, find the numerator of the fraction immediately to the
+! left of 3/7.
+
+
+! SOLUTION
+! --------
+
+! Use the properties of a Farey sequence by setting an upper bound of 3/7 and
+! then taking the mediant of that fraction and the one to its immediate left
+! repeatedly until the denominator is as close to 1000000 as possible without
+! going over.
+
+<PRIVATE
+
+: penultimate ( seq -- elt )
+    dup length 2 - swap nth ;
+
+: mediant ( a/c b/d -- [a+b]/[c+d] )
+    [ >fraction ] bi@ swapd [ + ] 2bi@ / ;
+
+PRIVATE>
+
+: euler071 ( -- answer )
+    2/5 [ dup denominator 1000000 <= ] [ 3/7 mediant dup ] [ ] produce
+    nip penultimate numerator ;
+
+! [ euler071 ] 100 ave-time
+! 155 ms ave run time - 6.95 SD (100 trials)
+
+MAIN: euler071