diff --git a/extra/project-euler/049/049.factor b/extra/project-euler/049/049.factor index 8b6f635ee4..08244ea023 100644 --- 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 [ - '[ 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 index 0000000000..d402b16902 --- /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 index 0000000000..eed179851e --- /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. + +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 6995adcd6a..1f29ca0af5 100644 --- 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 [ + '[ 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 ;