1 ! Copyright (c) 2009 Aaron Schaefer.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays byte-arrays fry hints kernel math math.combinatorics
4 math.functions math.parser math.primes project-euler.common sequences sets ;
7 ! http://projecteuler.net/index.php?section=problems&id=49
12 ! The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
13 ! increases by 3330, is unusual in two ways: (i) each of the three terms are
14 ! prime, and, (ii) each of the 4-digit numbers are permutations of one another.
16 ! There are no arithmetic sequences made up of three 1-, 2-, or 3-digit primes,
17 ! exhibiting this property, but there is one other 4-digit increasing sequence.
19 ! What 12-digit number do you form by concatenating the three terms in this
28 : count-digits ( n -- byte-array )
30 '[ 10 /mod _ [ 1 + ] change-nth dup 0 > ] loop drop
33 HINTS: count-digits fixnum ;
35 : permutations? ( n m -- ? )
36 [ count-digits ] bi@ = ;
38 : collect-permutations ( seq -- seq )
39 [ V{ } clone ] [ dup ] bi* [
40 dupd '[ _ permutations? ] filter
41 [ diff ] keep pick push
44 : potential-sequences ( -- seq )
45 1000 9999 primes-between
46 collect-permutations [ length 3 >= ] filter ;
48 : arithmetic-terms ( m n -- seq )
49 2dup [ swap - ] keep + 3array ;
51 : (find-unusual-terms) ( n seq -- seq/f )
52 [ [ arithmetic-terms ] with map ] keep
53 '[ _ [ last ] dip member? ] find nip ;
55 : find-unusual-terms ( seq -- seq/? )
56 unclip-slice over (find-unusual-terms) [
59 dup length 3 >= [ find-unusual-terms ] [ drop f ] if
62 : 4digit-concat ( seq -- str )
63 0 [ [ 10000 * ] dip + ] reduce ;
67 : euler049 ( -- answer )
68 potential-sequences [ find-unusual-terms ] map sift
69 [ { 1487 4817 8147 } = not ] find nip 4digit-concat ;
71 ! [ euler049 ] 100 ave-time
72 ! 206 ms ave run time - 10.25 SD (100 trials)