more library usage and readability improvements
parent
2dafa24383
commit
a6a5245edb
extra/project-euler/051
|
@ -1,38 +1,60 @@
|
|||
! Copyright (C) 2009 Jon Harper.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=1
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
|
||||
! By replacing the first digit of *3, it turns out that
|
||||
! six of the nine possible values:
|
||||
! 13, 23, 43, 53, 73, and 83, are all prime.
|
||||
! By replacing the third and fourth digits of 56**3 with the same digit,
|
||||
! this 5-digit number is the first example having seven primes among
|
||||
! the ten generated numbers, yielding the family:
|
||||
! 56003, 56113, 56333, 56443, 56663, 56773, and 56993.
|
||||
! Consequently 56003, being the first member of this family,
|
||||
! is the smallest prime with this property.
|
||||
!
|
||||
! Find the smallest prime which, by replacing part of the number
|
||||
! (not necessarily adjacent digits) with the same digit,
|
||||
! is part of an eight prime value family.
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! 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.
|
||||
|
||||
USING: assocs kernel math math.combinatorics math.functions
|
||||
math.parser math.primes namespaces project-euler.common
|
||||
sequences sets strings grouping math.ranges arrays ;
|
||||
sequences sets strings grouping math.ranges arrays fry math.order ;
|
||||
IN: project-euler.051
|
||||
|
||||
<PRIVATE
|
||||
SYMBOL: family-count
|
||||
SYMBOL: large-families
|
||||
: reset-globals ( -- )
|
||||
H{ } clone family-count set
|
||||
H{ } clone large-families set ;
|
||||
|
||||
: append-or-create ( value seq/f -- seq )
|
||||
dup [ swap suffix ] [ drop 1array ] if ;
|
||||
: append-at ( value key assoc -- )
|
||||
[ at append-or-create ] 2keep set-at ;
|
||||
: digits-positions ( str -- positions )
|
||||
H{ } clone swap over [ swapd append-at ] curry each-index ;
|
||||
: digits-positions ( str -- positions )
|
||||
H{ } clone [ '[ swap _ push-at ] each-index ] keep ;
|
||||
|
||||
: *-if-index ( char combination index -- char )
|
||||
member? [ drop CHAR: * ] when ;
|
||||
: replace-positions-with-* ( str positions -- str )
|
||||
[ *-if-index ] curry map-index ;
|
||||
: all-size-combinations ( seq -- combinations )
|
||||
: all-positions-combinations ( seq -- combinations )
|
||||
dup length [1,b] [ all-combinations ] with map concat ;
|
||||
|
||||
: families ( stra -- seq )
|
||||
dup digits-positions values
|
||||
[ all-size-combinations [ replace-positions-with-* ] with map ] with map concat ;
|
||||
[ all-positions-combinations [ replace-positions-with-* ] with map ] with map concat ;
|
||||
|
||||
: save-family ( family -- )
|
||||
family-count get dupd at 8 = [ large-families get conjoin ] [ drop ] if ;
|
||||
dup family-count get at 8 = [ large-families get conjoin ] [ drop ] if ;
|
||||
: increment-family ( family -- )
|
||||
family-count get dupd at* [ 1 + ] [ drop 1 ] if swap family-count get set-at ;
|
||||
family-count get inc-at ;
|
||||
: handle-family ( family -- )
|
||||
[ increment-family ] [ save-family ] bi ;
|
||||
|
||||
|
@ -52,7 +74,11 @@ SYMBOL: large-families
|
|||
: (euler051) ( i -- answer )
|
||||
dup test-n-digits-primes
|
||||
dup assoc-size 0 >
|
||||
[ nip values [ fill-*-with-ones string>number ] map infimum ]
|
||||
[ nip values [ fill-*-with-ones string>number ] [ min ] map-reduce ]
|
||||
[ drop 1 + (euler051) ] if ;
|
||||
PRIVATE>
|
||||
|
||||
: euler051 ( -- answer )
|
||||
2 (euler051) ;
|
||||
|
||||
SOLUTION: euler051
|
||||
|
|
Loading…
Reference in New Issue