Solution to Project Euler problem 47

extra/project-euler/047/047.factor

@@ -0,0 +1,95 @@
+! Copyright (c) 2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays combinators.lib kernel math math.primes math.primes.factors math.ranges namespaces sequences ;
+IN: project-euler.047
+
+! http://projecteuler.net/index.php?section=problems&id=47
+
+! DESCRIPTION
+! -----------
+
+! The first two consecutive numbers to have two distinct prime factors are:
+
+!     14 = 2 * 7
+!     15 = 3 * 5
+
+! The first three consecutive numbers to have three distinct prime factors are:
+
+!     644 = 2² * 7 * 23
+!     645 = 3 * 5 * 43
+!     646 = 2 * 17 * 19.
+
+! Find the first four consecutive integers to have four distinct primes
+! factors. What is the first of these numbers?
+
+
+! SOLUTION
+! --------
+
+! Brute force, not sure why it's incredibly slow compared to other languages
+
+<PRIVATE
+
+: (consecutive) ( count goal test -- n )
+    pick pick = [
+        swap - nip
+    ] [
+        dup prime? [ [ drop 0 ] dipd ] [
+            2dup unique-factors length = [ [ 1+ ] dipd ] [ [ drop 0 ] dipd ] if
+        ] if 1+ (consecutive)
+    ] if ;
+
+: consecutive ( goal test -- n )
+    0 -rot (consecutive) ;
+
+PRIVATE>
+
+: euler047 ( -- answer )
+    4 646 consecutive ;
+
+! [ euler047 ] time
+! 542708 ms run / 60548 ms GC time
+
+
+! ALTERNATE SOLUTIONS
+! -------------------
+
+! Use a sieve to generate prime factor counts up to a limit, then look for a
+! repetition of the specified number of factors.
+
+<PRIVATE
+
+SYMBOL: sieve
+
+: initialize-sieve ( n -- )
+    0 <repetition> >array sieve set ;
+
+: is-prime? ( index -- ? )
+    sieve get nth zero? ;
+
+: multiples ( n -- seq )
+    sieve get length 1- over <range> ;
+
+: increment-counts ( n -- )
+     multiples [ sieve get [ 1+ ] change-nth ] each ;
+
+: prime-tau-upto ( limit -- seq )
+    dup initialize-sieve 2 swap [a,b) [
+        dup is-prime? [ increment-counts ] [ drop ] if
+    ] each sieve get ;
+
+: consecutive-under ( m limit -- n/f )
+    prime-tau-upto [ dup <repetition> ] dip start ;
+
+PRIVATE>
+
+: euler047a ( -- answer )
+    4 1000000 consecutive-under ;
+
+! [ euler047a ] 100 ave-time
+! 2589 ms run / 45 ms GC ave time - 100 trials
+
+! TODO: I don't like that you have to specify the upper bound, maybe try making
+! this lazy so it will also short-circuit when it finds the answer?
+
+MAIN: euler047a

extra/project-euler/project-euler.factor

@@ -13,10 +13,10 @@ USING: definitions io io.files kernel math math.parser project-euler.ave-time
     project-euler.033 project-euler.034 project-euler.035 project-euler.036
     project-euler.037 project-euler.038 project-euler.039 project-euler.040
     project-euler.041 project-euler.042 project-euler.043 project-euler.044
-    project-euler.045 project-euler.046 project-euler.048 project-euler.052
+    project-euler.045 project-euler.046 project-euler.047 project-euler.048
-    project-euler.053 project-euler.056 project-euler.067 project-euler.075
+    project-euler.052 project-euler.053 project-euler.056 project-euler.067
-    project-euler.079 project-euler.092 project-euler.097 project-euler.134
+    project-euler.075 project-euler.079 project-euler.092 project-euler.097
-    project-euler.169 project-euler.173 project-euler.175 ;
+    project-euler.134 project-euler.169 project-euler.173 project-euler.175 ;
 IN: project-euler
 
 <PRIVATE