extra/project-euler/051/051.factor

   1 ! Copyright (C) 2009 Jon Harper.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 ! http://projecteuler.net/index.php?section=problems&id=1
   5
   6 ! DESCRIPTION
   7 ! -----------
   8
   9
  10 ! By replacing the first digit of *3, it turns out that
  11 ! six of the nine possible values:
  12 ! 13, 23, 43, 53, 73, and 83, are all prime.
  13 ! By replacing the third and fourth digits of 56**3 with the same digit,
  14 ! this 5-digit number is the first example having seven primes among
  15 ! the ten generated numbers, yielding the family:
  16 ! 56003, 56113, 56333, 56443, 56663, 56773, and 56993.
  17 ! Consequently 56003, being the first member of this family,
  18 ! is the smallest prime with this property.
  19 !
  20 ! Find the smallest prime which, by replacing part of the number
  21 ! (not necessarily adjacent digits) with the same digit,
  22 ! is part of an eight prime value family.
  23
  24 ! SOLUTION
  25 ! --------
  26
  27 ! for each prime number, count the families it belongs to. When one reaches count of 8, stop, and get the smallest number by replacing * with ones.
  28
  29 USING: assocs kernel math math.combinatorics math.functions
  30 math.parser math.primes namespaces project-euler.common
  31 sequences sets strings grouping math.ranges arrays fry math.order ;
  32 FROM: namespaces => set ;
  33 IN: project-euler.051
  34 <PRIVATE
  35 SYMBOL: family-count
  36 SYMBOL: large-families
  37 : reset-globals ( -- )
  38     H{ } clone family-count set
  39     H{ } clone large-families set ;
  40
  41 : digits-positions ( str -- positions )
  42     H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
  43
  44 : *-if-index ( char combination index -- char )
  45     member? [ drop CHAR: * ] when ;
  46 : replace-positions-with-* ( str positions -- str )
  47     [ *-if-index ] curry map-index ;
  48 : all-positions-combinations ( seq -- combinations )
  49     dup length [1,b] [ all-combinations ] with map concat ;
  50
  51 : families ( stra -- seq )
  52     dup digits-positions values
  53     [ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
  54
  55 : save-family ( family -- )
  56     dup family-count get at 8 = [ large-families get conjoin ] [ drop ] if ;
  57 : increment-family ( family -- )
  58    family-count get inc-at ;
  59 : handle-family ( family -- )
  60     [ increment-family ] [ save-family ] bi ;
  61
  62 ! Test all primes that have length n
  63 : n-digits-primes ( n -- primes )
  64     [ 1 - 10^ ] [ 10^ ] bi primes-between ;
  65 : test-n-digits-primes ( n -- seq )
  66     reset-globals
  67     n-digits-primes
  68     [ number>string families [ handle-family ] each ] each
  69     large-families get ;
  70
  71 : fill-*-with-ones ( str -- str )
  72     [ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
  73
  74 ! recursively test all primes by length until we find an answer
  75 : (euler051) ( i -- answer )
  76     dup test-n-digits-primes
  77     dup assoc-size 0 >
  78     [ nip values [ fill-*-with-ones string>number ] [ min ] map-reduce ]
  79     [ drop 1 + (euler051) ] if ;
  80 PRIVATE>
  81
  82 : euler051 ( -- answer )
  83     2 (euler051) ;
  84
  85 SOLUTION: euler051