Paste: euler051
Author: | jon |
Mode: | factor |
Date: | Fri, 2 Oct 2009 16:27:40 |
Plain Text |
USING: assocs kernel math math.combinatorics math.functions
math.parser math.primes namespaces project-euler.common
sequences sets strings ;
IN: project-euler.051
SYMBOL: family-count
SYMBOL: large-families
: reset-globals
H{ } clone family-count set
H{ } clone large-families set ;
: *-if-index
swap member? [ drop CHAR: * ] when ;
: family
[ *-if-index ] with map-index ;
: family-with-n-stars
[ [ length iota ] keep ] dip swap [ family ] curry map-combinations ;
: possible-family?
[ CHAR: * = [ drop 0 ] unless ] 2map [ 0 = not ] filter prune length 1 = ;
: families
dup
dup length iota rest [ family-with-n-stars ] with map concat
[ possible-family? ] with filter ;
: 10^n 10 swap ^ ; inline
: n-digits-primes
[ 1 - 10^n [ <= ] curry ] [ 10^n ] bi primes-upto swap trim-head ;
: save-family
family-count get dupd at 8 = [ large-families get conjoin ] [ drop ] if ;
: increment-family
family-count get dupd at* [ 1 + ] [ drop 1 ] if swap family-count get set-at ;
: handle-family
[ increment-family ] [ save-family ] bi ;
: test-n-digits-primes
reset-globals
n-digits-primes
[ number>string families [ handle-family ] each ] each
large-families get ;
: fill-*-with-ones
[ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
: (euler051)
dup test-n-digits-primes
dup assoc-size 0 >
[ nip values [ fill-*-with-ones string>number ] map infimum ]
[ drop 1 + (euler051) ] if ;
: euler051
2 (euler051) ;
Author: | jon |
Mode: | factor |
Date: | Sat, 3 Oct 2009 10:32:31 |
Plain Text |
USING: assocs kernel math math.combinatorics math.functions
math.parser math.primes namespaces project-euler.common
sequences sets strings grouping math.ranges arrays ;
IN: project-euler.051
SYMBOL: family-count
SYMBOL: large-families
: reset-globals
H{ } clone family-count set
H{ } clone large-families set ;
: append-or-create
dup [ swap suffix ] [ drop 1array ] if ;
: append-at
[ at append-or-create ] 2keep set-at ;
: digits-positions
H{ } clone swap over [ swapd append-at ] curry each-index ;
: *-if-index
member? [ drop CHAR: * ] when ;
: replace-positions-with-*
[ *-if-index ] curry map-index ;
: all-size-combinations
dup length [1,b] [ all-combinations ] with map concat ;
: families
dup digits-positions values
[ all-size-combinations [ replace-positions-with-* ] with map ] with map concat ;
: save-family
family-count get dupd at 8 = [ large-families get conjoin ] [ drop ] if ;
: increment-family
family-count get dupd at* [ 1 + ] [ drop 1 ] if swap family-count get set-at ;
: handle-family
[ increment-family ] [ save-family ] bi ;
: n-digits-primes
[ 1 - 10^ ] [ 10^ ] bi primes-between ;
: test-n-digits-primes
reset-globals
n-digits-primes
[ number>string families [ handle-family ] each ] each
large-families get ;
: fill-*-with-ones
[ dup CHAR: * = [ drop CHAR: 1 ] when ] map ;
: (euler051)
dup test-n-digits-primes
dup assoc-size 0 >
[ nip values [ fill-*-with-ones string>number ] map infimum ]
[ drop 1 + (euler051) ] if ;
: euler051
2 (euler051) ;
New Annotation