Solution to Project Euler problem 26

extra/project-euler/026/026.factor

@@ -0,0 +1,71 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.functions math.primes math.ranges sequences ;
+IN: project-euler.026
+
+! http://projecteuler.net/index.php?section=problems&id=26
+
+! DESCRIPTION
+! -----------
+
+! A unit fraction contains 1 in the numerator. The decimal representation of
+! the unit fractions with denominators 2 to 10 are given:
+
+!     1/2  =  0.5
+!     1/3  =  0.(3)
+!     1/4  =  0.25
+!     1/5  =  0.2
+!     1/6  =  0.1(6)
+!     1/7  =  0.(142857)
+!     1/8  =  0.125
+!     1/9  =  0.(1)
+!     1/10 =  0.1
+
+! Where 0.1(6) means 0.166666..., and has a 1-digit recurring cycle. It can be
+! seen that 1/7 has a 6-digit recurring cycle.
+
+! Find the value of d < 1000 for which 1/d contains the longest recurring cycle
+! in its decimal fraction part.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: source-026 ( -- seq )
+    1 1000 (a,b) [ prime? ] subset [ 1 swap / ] map ;
+
+: (mult-order) ( n a m -- k )
+    3dup ^ swap mod 1 = [ 2nip ] [ 1+ (mult-order) ] if ;
+
+PRIVATE>
+
+: coprime? ( m n -- ? )
+    gcd 1 = nip ;
+
+: recurring-period? ( a/b -- ? )
+    denominator 10 coprime? ;
+
+! Multiplicative order a.k.a. modulo order
+: mult-order ( a n -- k )
+    swap 1 (mult-order) ;
+
+: period-length ( a/b -- n )
+    dup recurring-period? [ denominator 10 swap mult-order ] [ drop 0 ] if ;
+
+<PRIVATE
+
+: max-period ( seq -- elt n )
+    dup [ period-length ] map dup supremum
+    over index [ swap nth ] curry 2apply ;
+
+PRIVATE>
+
+: euler026 ( -- answer )
+    source-026 max-period drop denominator ;
+
+! [ euler026 ] 100 ave-time
+! 724 ms run / 7 ms GC ave time - 100 trials
+
+MAIN: euler026

extra/project-euler/project-euler.factor

@@ -8,8 +8,8 @@ USING: definitions io io.files kernel math.parser sequences vocabs
     project-euler.013 project-euler.014 project-euler.015 project-euler.016
     project-euler.017 project-euler.018 project-euler.019 project-euler.020
     project-euler.021 project-euler.022 project-euler.023 project-euler.024
-    project-euler.025 project-euler.067 project-euler.134 project-euler.169
-    project-euler.173 project-euler.175 ;
+    project-euler.025 project-euler.026 project-euler.067 project-euler.134
+    project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE