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.order math.parser math.primes ranges namespaces
  31 project-euler.common sequences sets ;
  32 IN: project-euler.051
  33 <PRIVATE
  34 SYMBOL: family-count
  35 SYMBOL: large-families
  36 : reset-globals ( -- )
  37     H{ } clone family-count namespaces:set
  38     HS{ } clone large-families namespaces:set ;
  39
  40 : digits-positions ( str -- positions )
  41     H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
  42
  43 : *-if-index ( char combination index -- char )
  44     member? [ drop CHAR: * ] when ;
  45 : replace-positions-with-* ( str positions -- str )
  46     [ *-if-index ] curry map-index ;
  47 : all-positions-combinations ( seq -- combinations )
  48     dup length [1..b] [ all-combinations ] with map concat ;
  49
  50 : families ( stra -- seq )
  51     dup digits-positions values
  52     [ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
  53
  54 : save-family ( family -- )
  55     dup family-count get at 8 = [ large-families get adjoin ] [ drop ] if ;
  56 : increment-family ( family -- )
  57    family-count get inc-at ;
  58 : handle-family ( family -- )
  59     [ increment-family ] [ save-family ] bi ;
  60
  61 ! Test all primes that have length n
  62 : n-digits-primes ( n -- primes )
  63     [ 1 - 10^ ] [ 10^ ] bi primes-between ;
  64 : test-n-digits-primes ( n -- seq )
  65     reset-globals
  66     n-digits-primes
  67     [ number>string families [ handle-family ] each ] each
  68     large-families get members ;
  69
  70 : fill-*-with-ones ( str -- str )
  71     [ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
  72
  73 ! recursively test all primes by length until we find an answer
  74 : (euler051) ( i -- answer )
  75     dup test-n-digits-primes [
  76         1 + (euler051)
  77     ] [
  78         nip [ fill-*-with-ones string>number ] [ min ] map-reduce
  79     ] if-empty ;
  80
  81 PRIVATE>
  82
  83 : euler051 ( -- answer )
  84     2 (euler051) ;
  85
  86 SOLUTION: euler051