Solution to Project Euler problem 70

diff --git a/extra/project-euler/049/049.factor b/extra/project-euler/049/049.factor
index 8b6f635ee4bb5c932c65ae2a4fde0b7a70b47390..08244ea0235c93271a78f466f15a1297d80b8f9e 100644 (file)
--- a/extra/project-euler/049/049.factor
+++ b/extra/project-euler/049/049.factor
@@ -1,7 +1,7 @@
 ! Copyright (c) 2009 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays fry hints kernel math math.combinatorics
-    math.functions math.parser math.primes project-euler.common sequences sets ;
+USING: arrays byte-arrays fry kernel math math.combinatorics math.functions
+    math.parser math.primes project-euler.common sequences sets ;
 IN: project-euler.049
 
 ! http://projecteuler.net/index.php?section=problems&id=49
@@ -25,16 +25,6 @@ IN: project-euler.049
 
 <PRIVATE
 
-: count-digits ( n -- byte-array )
-    10 <byte-array> [
-        '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
-    ] keep ;
-
-HINTS: count-digits fixnum ;
-
-: permutations? ( n m -- ? )
-    [ count-digits ] bi@ = ;
-
 : collect-permutations ( seq -- seq )
     [ V{ } clone ] [ dup ] bi* [
         dupd '[ _ permutations? ] filter

diff --git a/extra/project-euler/070/070-tests.factor b/extra/project-euler/070/070-tests.factor
new file mode 100644 (file)
index 0000000..d402b16
--- /dev/null
+++ b/extra/project-euler/070/070-tests.factor
@@ -0,0 +1,4 @@
+USING: project-euler.070 tools.test ;
+IN: project-euler.070.tests
+
+[ 8319823 ] [ euler070 ] unit-test

diff --git a/extra/project-euler/070/070.factor b/extra/project-euler/070/070.factor
new file mode 100644 (file)
index 0000000..eed1798
--- /dev/null
+++ b/extra/project-euler/070/070.factor
@@ -0,0 +1,67 @@
+! Copyright (c) 2010 Aaron Schaefer. All rights reserved.
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: arrays assocs combinators.short-circuit kernel math math.combinatorics
+    math.functions math.primes math.ranges project-euler.common sequences ;
+IN: project-euler.070
+
+! http://projecteuler.net/index.php?section=problems&id=70
+
+! DESCRIPTION
+! -----------
+
+! Euler's Totient function, φ(n) [sometimes called the phi function], is used
+! to determine the number of positive numbers less than or equal to n which are
+! relatively prime to n. For example, as 1, 2, 4, 5, 7, and 8, are all less
+! than nine and relatively prime to nine, φ(9)=6. The number 1 is considered to
+! be relatively prime to every positive number, so φ(1)=1.
+
+! Interestingly, φ(87109)=79180, and it can be seen that 87109 is a permutation
+! of 79180.
+
+! Find the value of n, 1 < n < 10^(7), for which φ(n) is a permutation of n and
+! the ratio n/φ(n) produces a minimum.
+
+
+! SOLUTION
+! --------
+
+! For n/φ(n) to be minimised, φ(n) must be as close to n as possible; that is,
+! we want to maximise φ(n). The minimal solution for n/φ(n) would be if n was
+! prime giving n/(n-1) but since n-1 never is a permutation of n it cannot be
+! prime.
+
+! The next best thing would be if n only consisted of 2 prime factors close to
+! (in this case) sqrt(10000000). Hence n = p1*p2 and we only need to search
+! through a list of known prime pairs. In addition:
+
+!     φ(p1*p2) = p1*p2*(1-1/p1)(1-1/p2) = (p1-1)(p2-1)
+
+! ...so we can compute φ(n) more efficiently.
+
+<PRIVATE
+
+! NOTE: ±1000 is an arbitrary range
+: likely-prime-factors ( -- seq )
+    7 10^ sqrt >integer 1000 [ - ] [ + ] 2bi primes-between ; inline
+
+: n-and-phi ( seq -- seq' )
+    #! ( seq  = { p1, p2 } -- seq' = { n, φ(n) } )
+    [ product ] [ [ 1 - ] map product ] bi 2array ;
+
+: fit-requirements? ( seq -- ? )
+    first2 { [ drop 7 10^ < ] [ permutations? ] } 2&& ;
+
+: minimum-ratio ( seq -- n )
+    [ [ first2 / ] map [ infimum ] keep index ] keep nth first ;
+
+PRIVATE>
+
+: euler070 ( -- answer )
+   likely-prime-factors 2 all-combinations [ n-and-phi ] map
+   [ fit-requirements? ] filter minimum-ratio ;
+
+! [ euler070 ] 100 ave-time
+! 379 ms ave run time - 1.15 SD (100 trials)
+
+SOLUTION: euler070

diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor
index 6995adcd6a11e2494951612bc775aa1230ce9e43..1f29ca0af529308cee1c4cd9b6f84dc7a8b1574e 100644 (file)
--- a/extra/project-euler/common/common.factor
+++ b/extra/project-euler/common/common.factor
@@ -1,10 +1,11 @@
 ! Copyright (c) 2007-2010 Aaron Schaefer.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel lists make math math.functions math.matrices
-    math.primes.miller-rabin math.order math.parser math.primes.factors
-    math.primes.lists math.ranges math.ratios namespaces parser prettyprint
-    quotations sequences sorting strings unicode.case vocabs vocabs.parser
-    words ;
+! The contents of this file are licensed under the Simplified BSD License
+! A copy of the license is available at http://factorcode.org/license.txt
+USING: accessors arrays byte-arrays fry hints kernel lists make math
+    math.functions math.matrices math.order math.parser math.primes.factors
+    math.primes.lists math.primes.miller-rabin math.ranges math.ratios
+    namespaces parser prettyprint quotations sequences sorting strings
+    unicode.case vocabs vocabs.parser words ;
 IN: project-euler.common
 
 ! A collection of words used by more than one Project Euler solution
@@ -25,6 +26,7 @@ IN: project-euler.common
 ! pentagonal? - #44, #45
 ! penultimate - #69, #71
 ! propagate-all - #18, #67
+! permutations? - #49, #70
 ! sum-proper-divisors - #21
 ! tau* - #12
 ! [uad]-transform - #39, #75
@@ -38,6 +40,13 @@ IN: project-euler.common
 
 <PRIVATE
 
+: count-digits ( n -- byte-array )
+    10 <byte-array> [
+        '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
+    ] keep ;
+
+HINTS: count-digits fixnum ;
+
 : max-children ( seq -- seq )
     [ dup length 1 - iota [ nth-pair max , ] with each ] { } make ;
 
@@ -107,6 +116,9 @@ PRIVATE>
     reverse [ first dup ] [ rest ] bi
     [ propagate dup ] map nip reverse swap suffix ;
 
+: permutations? ( n m -- ? )
+    [ count-digits ] bi@ = ;
+
 : sum-divisors ( n -- sum )
     dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;