Merge branch 'master' of git://projects.elasticdog.com/git/factor
Slava Pestov
commit
a06eec802b
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib hashtables kernel math math.combinatorics math.parser
|
||||
math.ranges project-euler.common sequences sorting ;
|
||||
math.ranges project-euler.common sequences ;
|
||||
IN: project-euler.032
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=32
|
||||
|
|
@ -63,9 +63,6 @@ PRIVATE>
|
|||
: source-032a ( -- seq )
|
||||
50 [1,b] 2000 [1,b] cartesian-product ;
|
||||
|
||||
: pandigital? ( n -- ? )
|
||||
number>string natural-sort "123456789" = ;
|
||||
|
||||
! multiplicand/multiplier/product
|
||||
: mmp ( pair -- n )
|
||||
first2 2dup * [ number>string ] 3apply 3append 10 string>integer ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.parser math.primes sequences ;
|
||||
IN: project-euler.037
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=37
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! The number 3797 has an interesting property. Being prime itself, it is
|
||||
! possible to continuously remove digits from left to right, and remain prime
|
||||
! at each stage: 3797, 797, 97, and 7. Similarly we can work from right to
|
||||
! left: 3797, 379, 37, and 3.
|
||||
|
||||
! Find the sum of the only eleven primes that are both truncatable from left to
|
||||
! right and right to left.
|
||||
|
||||
! NOTE: 2, 3, 5, and 7 are not considered to be truncatable primes.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: r-trunc? ( n -- ? )
|
||||
10 /i dup 0 > [
|
||||
dup prime? [ r-trunc? ] [ drop f ] if
|
||||
] [
|
||||
drop t
|
||||
] if ;
|
||||
|
||||
: reverse-digits ( n -- m )
|
||||
number>string reverse 10 string>integer ;
|
||||
|
||||
: l-trunc? ( n -- ? )
|
||||
reverse-digits 10 /i reverse-digits dup 0 > [
|
||||
dup prime? [ l-trunc? ] [ drop f ] if
|
||||
] [
|
||||
drop t
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler037 ( -- answer )
|
||||
23 1000000 primes-between [ r-trunc? ] subset [ l-trunc? ] subset sum ;
|
||||
|
||||
! [ euler037 ] 100 ave-time
|
||||
! 768 ms run / 9 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler037
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.parser math.ranges project-euler.common sequences ;
|
||||
IN: project-euler.038
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=38
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Take the number 192 and multiply it by each of 1, 2, and 3:
|
||||
|
||||
! 192 × 1 = 192
|
||||
! 192 × 2 = 384
|
||||
! 192 × 3 = 576
|
||||
|
||||
! By concatenating each product we get the 1 to 9 pandigital, 192384576. We
|
||||
! will call 192384576 the concatenated product of 192 and (1,2,3)
|
||||
|
||||
! The same can be achieved by starting with 9 and multiplying by 1, 2, 3, 4,
|
||||
! and 5, giving the pandigital, 918273645, which is the concatenated product of
|
||||
! 9 and (1,2,3,4,5).
|
||||
|
||||
! What is the largest 1 to 9 pandigital 9-digit number that can be formed as
|
||||
! the concatenated product of an integer with (1,2, ... , n) where n > 1?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! Only need to search 4-digit numbers starting with 9 since a 2-digit number
|
||||
! starting with 9 would produce 8 or 11 digits, and a 3-digit number starting
|
||||
! with 9 would produce 7 or 11 digits.
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (concat-product) ( accum n multiplier -- m )
|
||||
pick length 8 > [
|
||||
2drop 10 swap digits>integer
|
||||
] [
|
||||
[ * number>digits over push-all ] 2keep 1+ (concat-product)
|
||||
] if ;
|
||||
|
||||
: concat-product ( n -- m )
|
||||
V{ } clone swap 1 (concat-product) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler038 ( -- answer )
|
||||
9123 9876 [a,b] [ concat-product ] map [ pandigital? ] subset supremum ;
|
||||
|
||||
! [ euler038 ] 100 ave-time
|
||||
! 37 ms run / 1 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler038
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators.lib kernel math math.ranges namespaces
|
||||
project-euler.common sequences ;
|
||||
IN: project-euler.039
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=39
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! If p is the perimeter of a right angle triangle with integral length sides,
|
||||
! {a,b,c}, there are exactly three solutions for p = 120.
|
||||
|
||||
! {20,48,52}, {24,45,51}, {30,40,50}
|
||||
|
||||
! For which value of p < 1000, is the number of solutions maximised?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html
|
||||
! Identical implementation as problem #75
|
||||
|
||||
! Basically, this makes an array of 1000 zeros, recursively creates primitive
|
||||
! triples using the three transforms and then increments the array at index
|
||||
! [a+b+c] by one for each triple's sum AND its multiples under 1000 (to account
|
||||
! for non-primitive triples). The answer is just the index that has the highest
|
||||
! number.
|
||||
|
||||
SYMBOL: p-count
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: max-p ( -- n )
|
||||
p-count get length ;
|
||||
|
||||
: adjust-p-count ( n -- )
|
||||
max-p 1- over <range> p-count get
|
||||
[ [ 1+ ] change-nth ] curry each ;
|
||||
|
||||
: (count-perimeters) ( seq -- )
|
||||
dup sum max-p < [
|
||||
dup sum adjust-p-count
|
||||
[ u-transform ] keep [ a-transform ] keep d-transform
|
||||
[ (count-perimeters) ] 3apply
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: count-perimeters ( n -- )
|
||||
0 <array> p-count set { 3 4 5 } (count-perimeters) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler039 ( -- answer )
|
||||
[
|
||||
1000 count-perimeters p-count get [ supremum ] keep index
|
||||
] with-scope ;
|
||||
|
||||
! [ euler039 ] 100 ave-time
|
||||
! 2 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler039
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.parser sequences strings ;
|
||||
IN: project-euler.040
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=40
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! An irrational decimal fraction is created by concatenating the positive
|
||||
! integers:
|
||||
|
||||
! 0.123456789101112131415161718192021...
|
||||
|
||||
! It can be seen that the 12th digit of the fractional part is 1.
|
||||
|
||||
! If dn represents the nth digit of the fractional part, find the value of the
|
||||
! following expression.
|
||||
|
||||
! d1 × d10 × d100 × d1000 × d10000 × d100000 × d1000000
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (concat-upto) ( n limit str -- str )
|
||||
2dup length > [
|
||||
pick number>string over push-all rot 1+ -rot (concat-upto)
|
||||
] [
|
||||
2nip
|
||||
] if ;
|
||||
|
||||
: concat-upto ( n -- str )
|
||||
SBUF" " clone 1 -rot (concat-upto) ;
|
||||
|
||||
: nth-integer ( n str -- m )
|
||||
[ 1- ] dip nth 1string 10 string>integer ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler040 ( -- answer )
|
||||
1000000 concat-upto { 1 10 100 1000 10000 100000 1000000 }
|
||||
[ swap nth-integer ] with map product ;
|
||||
|
||||
! [ euler040 ] 100 ave-time
|
||||
! 1002 ms run / 43 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler040
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
! Copyright (c) 2008 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators.lib kernel math math.ranges namespaces
|
||||
project-euler.common sequences ;
|
||||
IN: project-euler.075
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=75
|
||||
|
||||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! It turns out that 12 cm is the smallest length of wire can be bent to form a
|
||||
! right angle triangle in exactly one way, but there are many more examples.
|
||||
|
||||
! 12 cm: (3,4,5)
|
||||
! 24 cm: (6,8,10)
|
||||
! 30 cm: (5,12,13)
|
||||
! 36 cm: (9,12,15)
|
||||
! 40 cm: (8,15,17)
|
||||
! 48 cm: (12,16,20)
|
||||
|
||||
! In contrast, some lengths of wire, like 20 cm, cannot be bent to form a right
|
||||
! angle triangle, and other lengths allow more than one solution to be found;
|
||||
! for example, using 120 cm it is possible to form exactly three different
|
||||
! right angle triangles.
|
||||
|
||||
! 120 cm: (30,40,50), (20,48,52), (24,45,51)
|
||||
|
||||
! Given that L is the length of the wire, for how many values of L ≤ 1,000,000
|
||||
! can exactly one right angle triangle be formed?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html
|
||||
! Identical implementation as problem #39
|
||||
|
||||
! Basically, this makes an array of 1000000 zeros, recursively creates
|
||||
! primitive triples using the three transforms and then increments the array at
|
||||
! index [a+b+c] by one for each triple's sum AND its multiples under 1000000
|
||||
! (to account for non-primitive triples). The answer is just the total number
|
||||
! of indexes that are equal to one.
|
||||
|
||||
SYMBOL: p-count
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: max-p ( -- n )
|
||||
p-count get length ;
|
||||
|
||||
: adjust-p-count ( n -- )
|
||||
max-p 1- over <range> p-count get
|
||||
[ [ 1+ ] change-nth ] curry each ;
|
||||
|
||||
: (count-perimeters) ( seq -- )
|
||||
dup sum max-p < [
|
||||
dup sum adjust-p-count
|
||||
[ u-transform ] keep [ a-transform ] keep d-transform
|
||||
[ (count-perimeters) ] 3apply
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
|
||||
: count-perimeters ( n -- )
|
||||
0 <array> p-count set { 3 4 5 } (count-perimeters) ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler075 ( -- answer )
|
||||
[
|
||||
1000000 count-perimeters p-count get [ 1 = ] count
|
||||
] with-scope ;
|
||||
|
||||
! [ euler075 ] 100 ave-time
|
||||
! 1873 ms run / 123 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler075
|
||||
|
|
@ -1,5 +1,6 @@
|
|||
USING: arrays combinators.lib kernel math math.functions math.miller-rabin
|
||||
math.parser math.primes.factors math.ranges namespaces sequences ;
|
||||
math.matrices math.parser math.primes.factors math.ranges namespaces
|
||||
sequences sorting ;
|
||||
IN: project-euler.common
|
||||
|
||||
! A collection of words used by more than one Project Euler solution
|
||||
|
|
@ -12,9 +13,11 @@ IN: project-euler.common
|
|||
! log10 - #25, #134
|
||||
! max-path - #18, #67
|
||||
! number>digits - #16, #20, #30, #34
|
||||
! pandigital? - #32, #38
|
||||
! propagate-all - #18, #67
|
||||
! sum-proper-divisors - #21
|
||||
! tau* - #12
|
||||
! [uad]-transform - #39, #75
|
||||
|
||||
|
||||
: nth-pair ( n seq -- nth next )
|
||||
|
|
@ -44,6 +47,9 @@ IN: project-euler.common
|
|||
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
|
||||
] { } make sum ;
|
||||
|
||||
: transform ( triple matrix -- new-triple )
|
||||
[ 1array ] dip m. first ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
|
||||
|
|
@ -67,6 +73,9 @@ PRIVATE>
|
|||
: number>digits ( n -- seq )
|
||||
number>string string>digits ;
|
||||
|
||||
: pandigital? ( n -- ? )
|
||||
number>string natural-sort "123456789" = ;
|
||||
|
||||
! Not strictly needed, but it is nice to be able to dump the triangle after the
|
||||
! propagation
|
||||
: propagate-all ( triangle -- newtriangle )
|
||||
|
|
@ -97,3 +106,12 @@ PRIVATE>
|
|||
dup sqrt >fixnum [1,b] [
|
||||
dupd mod zero? [ [ 2 + ] dip ] when
|
||||
] each drop * ;
|
||||
|
||||
! These transforms are for generating primitive Pythagorean triples
|
||||
: u-transform ( triple -- new-triple )
|
||||
{ { 1 2 2 } { -2 -1 -2 } { 2 2 3 } } transform ;
|
||||
: a-transform ( triple -- new-triple )
|
||||
{ { 1 2 2 } { 2 1 2 } { 2 2 3 } } transform ;
|
||||
: d-transform ( triple -- new-triple )
|
||||
{ { -1 -2 -2 } { 2 1 2 } { 2 2 3 } } transform ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: definitions io io.files kernel math.parser sequences vocabs
|
||||
vocabs.loader project-euler.ave-time project-euler.common math
|
||||
USING: definitions io io.files kernel math math.parser project-euler.ave-time
|
||||
sequences vocabs vocabs.loader
|
||||
project-euler.001 project-euler.002 project-euler.003 project-euler.004
|
||||
project-euler.005 project-euler.006 project-euler.007 project-euler.008
|
||||
project-euler.009 project-euler.010 project-euler.011 project-euler.012
|
||||
|
|
@ -11,8 +11,9 @@ USING: definitions io io.files kernel math.parser sequences vocabs
|
|||
project-euler.025 project-euler.026 project-euler.027 project-euler.028
|
||||
project-euler.029 project-euler.030 project-euler.031 project-euler.032
|
||||
project-euler.033 project-euler.034 project-euler.035 project-euler.036
|
||||
project-euler.067 project-euler.134 project-euler.169 project-euler.173
|
||||
project-euler.175 ;
|
||||
project-euler.037 project-euler.038 project-euler.039 project-euler.040
|
||||
project-euler.067 project-euler.075 project-euler.134 project-euler.169
|
||||
project-euler.173 project-euler.175 ;
|
||||
IN: project-euler
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
Loading…
Reference in New Issue