extra/project-euler/050/050.factor

   1 ! Copyright (c) 2008 Aaron Schaefer.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.order math.primes
   4 project-euler.common sequences ;
   5 IN: project-euler.050
   6
   7 ! https://projecteuler.net/problem=50
   8
   9 ! DESCRIPTION
  10 ! -----------
  11
  12 ! The prime 41, can be written as the sum of six consecutive
  13 ! primes:
  14
  15 !     41 = 2 + 3 + 5 + 7 + 11 + 13
  16
  17 ! This is the longest sum of consecutive primes that adds to a
  18 ! prime below one-hundred.
  19
  20 ! The longest sum of consecutive primes below one-thousand that
  21 ! adds to a prime, contains 21 terms, and is equal to 953.
  22
  23 ! Which prime, below one-million, can be written as the sum of
  24 ! the most consecutive primes?
  25
  26
  27 ! SOLUTION
  28 ! --------
  29
  30 ! 1) Create an sequence of all primes under 1000000.
  31 ! 2) Start summing elements in the sequence until the next
  32 !    number would put you over 1000000.
  33 ! 3) Check if that sum is prime, if not, subtract the last
  34 !    number added.
  35 ! 4) Repeat step 3 until you get a prime number, and store it
  36 !    along with the how many consecutive numbers from the
  37 !    original sequence it took to get there.
  38 ! 5) Drop the first number from the sequence of primes, and do
  39 !    steps 2-4 again
  40 ! 6) Compare the longest chain from the first run with the
  41 !    second run, and store the longer of the two.
  42 ! 7) If the sequence of primes is still longer than the longest
  43 !    chain, then repeat steps 5-7...otherwise, you've found the
  44 !    longest sum of consecutive primes!
  45
  46 <PRIVATE
  47
  48 :: sum-upto ( seq limit -- length sum )
  49     0 seq [ + dup limit > ] find
  50     [ swapd - ] [ drop seq length swap ] if* ;
  51
  52 : pop-until-prime ( seq sum -- seq prime )
  53     over length 0 > [
  54         [ unclip-last-slice ] dip swap -
  55         dup prime? [ pop-until-prime ] unless
  56     ] [
  57         2drop { } 0
  58     ] if ;
  59
  60 ! a pair is { length of chain, prime the chain sums to }
  61
  62 : longest-prime ( seq limit -- pair )
  63     dupd sum-upto dup prime? [
  64         2array nip
  65     ] [
  66         [ head-slice ] dip pop-until-prime
  67         [ length ] dip 2array
  68     ] if ;
  69
  70 : continue? ( pair seq -- ? )
  71     [ first ] [ length 1 - ] bi* < ;
  72
  73 : (find-longest) ( best seq limit -- best )
  74     [ longest-prime max ] 2keep 2over continue? [
  75         [ rest-slice ] dip (find-longest)
  76     ] [ 2drop ] if ;
  77
  78 : find-longest ( seq limit -- best )
  79     { 1 2 } -rot (find-longest) ;
  80
  81 : solve ( n -- answer )
  82     [ primes-upto ] keep find-longest second ;
  83
  84 PRIVATE>
  85
  86 : euler050 ( -- answer )
  87     1000000 solve ;
  88
  89 ! [ euler050 ] 100 ave-time
  90 ! 291 ms run / 20.6 ms GC ave time - 100 trials
  91
  92 SOLUTION: euler050