Solution to Project Euler problem 73

extra/project-euler/073/073-tests.factor

@@ -0,0 +1,4 @@
+USING: project-euler.073 tools.test ;
+IN: project-euler.073.tests
+
+[ 5066251 ] [ euler073 ] unit-test

extra/project-euler/073/073.factor

@@ -0,0 +1,52 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel locals make math project-euler.common sequences ;
+IN: project-euler.073
+
+! http://projecteuler.net/index.php?section=problems&id=73
+
+! 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 there are 3 fractions between 1/3 and 1/2.
+
+! How many fractions lie between 1/3 and 1/2 in the sorted set of reduced
+! proper fractions for d <= 10,000?
+
+
+! SOLUTION
+! --------
+
+! Use the properties of a Farey sequence and mediants to recursively generate
+! the next fraction until the denominator is as close to 1000000 as possible
+! without going over.
+
+<PRIVATE
+
+:: (euler073) ( limit lo hi -- )
+    [let | m [ lo hi mediant ] |
+        m denominator limit <= [
+            m ,
+            limit lo m (euler073)
+            limit m hi (euler073)
+        ] when
+    ] ;
+
+PRIVATE>
+
+: euler073 ( -- answer )
+    [ 10000 1/3 1/2 (euler073) ] { } make length ;
+
+! [ euler073 ] 10 ave-time
+! 20506 ms ave run time - 937.07 SD (10 trials)
+
+MAIN: euler073

extra/project-euler/project-euler.factor

@@ -15,12 +15,12 @@ USING: definitions io io.files kernel math math.parser
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
     project-euler.045 project-euler.046 project-euler.047 project-euler.048
     project-euler.052 project-euler.053 project-euler.055 project-euler.056
-    project-euler.059 project-euler.067 project-euler.071 project-euler.075
-    project-euler.076 project-euler.079 project-euler.092 project-euler.097
-    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.059 project-euler.067 project-euler.071 project-euler.073
+    project-euler.075 project-euler.076 project-euler.079 project-euler.092
+    project-euler.097 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 ;
 IN: project-euler
 
 <PRIVATE