extra/project-euler/047/047.factor

   1 ! Copyright (c) 2008 Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.primes math.primes.factors
   4     ranges namespaces sequences project-euler.common ;
   5 IN: project-euler.047
   6
   7 ! http://projecteuler.net/index.php?section=problems&id=47
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! The first two consecutive numbers to have two distinct prime factors are:
  13
  14 !     14 = 2 * 7
  15 !     15 = 3 * 5
  16
  17 ! The first three consecutive numbers to have three distinct prime factors are:
  18
  19 !     644 = 2² * 7 * 23
  20 !     645 = 3 * 5 * 43
  21 !     646 = 2 * 17 * 19.
  22
  23 ! Find the first four consecutive integers to have four distinct primes
  24 ! factors. What is the first of these numbers?
  25
  26
  27 ! SOLUTION
  28 ! --------
  29
  30 ! Brute force, not sure why it's incredibly slow compared to other languages
  31
  32 <PRIVATE
  33
  34 : (consecutive) ( count goal test -- n )
  35     2over = [
  36         swap - nip
  37     ] [
  38         dup prime? [ [ drop 0 ] 2dip ] [
  39             2dup unique-factors length = [ [ 1 + ] 2dip ] [ [ drop 0 ] 2dip ] if
  40         ] if 1 + (consecutive)
  41     ] if ;
  42
  43 : consecutive ( goal test -- n )
  44     0 -rot (consecutive) ;
  45
  46 PRIVATE>
  47
  48 : euler047 ( -- answer )
  49     4 646 consecutive ;
  50
  51 ! [ euler047 ] time
  52 ! 344688 ms run / 20727 ms GC time
  53
  54
  55 ! ALTERNATE SOLUTIONS
  56 ! -------------------
  57
  58 ! Use a sieve to generate prime factor counts up to an arbitrary limit, then
  59 ! look for a repetition of the specified number of factors.
  60
  61 <PRIVATE
  62
  63 SYMBOL: sieve
  64
  65 : initialize-sieve ( n -- )
  66     0 <repetition> >array sieve set ;
  67
  68 : is-prime? ( index -- ? )
  69     sieve get nth 0 = ;
  70
  71 : multiples ( n -- seq )
  72     sieve get length 1 - over <range> ;
  73
  74 : increment-counts ( n -- )
  75      multiples [ sieve get [ 1 + ] change-nth ] each ;
  76
  77 : prime-tau-upto ( limit -- seq )
  78     dup initialize-sieve 2 swap [a..b) [
  79         dup is-prime? [ increment-counts ] [ drop ] if
  80     ] each sieve get ;
  81
  82 : consecutive-under ( m limit -- n/f )
  83     prime-tau-upto [ dup <repetition> ] dip subseq-start ;
  84
  85 PRIVATE>
  86
  87 : euler047a ( -- answer )
  88     4 200000 consecutive-under ;
  89
  90 ! [ euler047a ] 100 ave-time
  91 ! 331 ms ave run time - 19.14 SD (100 trials)
  92
  93 ! TODO: I don't like that you have to specify the upper bound, maybe try making
  94 ! this lazy so it could also short-circuit when it finds the answer?
  95
  96 SOLUTION: euler047a