extra/project-euler/047/047.factor

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