extra/project-euler/049/049.factor

   1 ! Copyright (c) 2009 Aaron Schaefer.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math math.primes project-euler.common
   4 sequences sets ;
   5 FROM: project-euler.common => permutations? ;
   6 IN: project-euler.049
   7
   8 ! https://projecteuler.net/problem=49
   9
  10 ! DESCRIPTION
  11 ! -----------
  12
  13 ! The arithmetic sequence, 1487, 4817, 8147, in which each of
  14 ! the terms increases by 3330, is unusual in two ways: (i) each
  15 ! of the three terms are prime, and, (ii) each of the 4-digit
  16 ! numbers are permutations of one another.
  17
  18 ! There are no arithmetic sequences made up of three 1-, 2-, or
  19 ! 3-digit primes, exhibiting this property, but there is one
  20 ! other 4-digit increasing sequence.
  21
  22 ! What 12-digit number do you form by concatenating the three
  23 ! terms in this sequence?
  24
  25
  26 ! SOLUTION
  27 ! --------
  28
  29 <PRIVATE
  30
  31 : collect-permutations ( seq -- seq )
  32     [ V{ } clone ] [ dup ] bi* [
  33         dupd '[ _ permutations? ] filter
  34         [ diff ] keep pick push
  35     ] each drop ;
  36
  37 : potential-sequences ( -- seq )
  38     1000 9999 primes-between
  39     collect-permutations [ length 3 >= ] filter ;
  40
  41 : arithmetic-terms ( m n -- seq )
  42     2dup [ swap - ] keep + 3array ;
  43
  44 : (find-unusual-terms) ( n seq -- seq/f )
  45     [ [ arithmetic-terms ] with map ] keep
  46     '[ _ [ last ] dip member? ] find nip ;
  47
  48 : find-unusual-terms ( seq -- seq/? )
  49     unclip-slice over (find-unusual-terms) [
  50         nip
  51     ] [
  52         dup length 3 >= [ find-unusual-terms ] [ drop f ] if
  53     ] if* ;
  54
  55 : 4digit-concat ( seq -- str )
  56     0 [ [ 10000 * ] dip + ] reduce ;
  57
  58 PRIVATE>
  59
  60 : euler049 ( -- answer )
  61     potential-sequences [ find-unusual-terms ] map sift
  62     [ { 1487 4817 8147 } = not ] find nip 4digit-concat ;
  63
  64 ! [ euler049 ] 100 ave-time
  65 ! 206 ms ave run time - 10.25 SD (100 trials)
  66
  67 SOLUTION: euler049