Cleanup of all Project Euler solutions thus far
Aaron Schaefer
parent
7636671b8c
commit
50a3ad54da
|
|
@ -19,11 +19,15 @@ IN: project-euler.002
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: last2 ( seq -- elt last )
|
||||
2 tail* first2 ;
|
||||
<PRIVATE
|
||||
|
||||
: (fib-upto) ( seq n limit -- seq )
|
||||
2dup <= [ >r add dup 2 tail* sum r> (fib-upto) ] [ 2drop ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: fib-upto ( n -- seq )
|
||||
{ 0 } 1 [ pick dupd < ] [ add dup last2 + ] [ ] while drop nip ;
|
||||
{ 0 } 1 rot (fib-upto) ;
|
||||
|
||||
: euler002 ( -- answer )
|
||||
1000000 fib-upto [ even? ] subset sum ;
|
||||
|
|
|
|||
|
|
@ -16,13 +16,10 @@ IN: project-euler.003
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: largest-prime-factor ( n -- factor )
|
||||
factors supremum ;
|
||||
|
||||
: euler003 ( -- answer )
|
||||
317584931803 largest-prime-factor ;
|
||||
317584931803 factors supremum ;
|
||||
|
||||
! [ euler003 ] time
|
||||
! 2 ms run / 0 ms GC time
|
||||
! [ euler003 ] 100 ave-time
|
||||
! 1 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler003
|
||||
|
|
|
|||
|
|
@ -26,14 +26,16 @@ IN: project-euler.004
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: source-004 ( -- seq )
|
||||
100 999 [a,b] [ 10 mod zero? not ] subset ;
|
||||
|
||||
: max-palindrome ( seq -- palindrome )
|
||||
natural-sort [ palindrome? ] find-last nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler004 ( -- answer )
|
||||
100 999 [a,b] [ 10 mod zero? not ] subset dup
|
||||
cartesian-product [ product ] map prune max-palindrome ;
|
||||
source-004 dup cartesian-product [ product ] map prune max-palindrome ;
|
||||
|
||||
! [ euler004 ] 100 ave-time
|
||||
! 1608 ms run / 102 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions sequences ;
|
||||
USING: math math.functions sequences ;
|
||||
IN: project-euler.005
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=5
|
||||
|
|
|
|||
|
|
@ -18,12 +18,12 @@ IN: project-euler.007
|
|||
! --------
|
||||
|
||||
: nth-prime ( n -- n )
|
||||
1 - lprimes lnth ;
|
||||
1- lprimes lnth ;
|
||||
|
||||
: euler007 ( -- answer )
|
||||
10001 nth-prime ;
|
||||
|
||||
! [ euler007 ] time
|
||||
! 22 ms run / 0 ms GC time
|
||||
! [ euler007 ] 100 ave-time
|
||||
! 10 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler007
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.parser project-euler.common sequences ;
|
||||
USING: math.parser project-euler.common sequences ;
|
||||
IN: project-euler.008
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=8
|
||||
|
|
|
|||
|
|
@ -26,20 +26,18 @@ IN: project-euler.009
|
|||
|
||||
: next-pq ( p1 q1 -- p2 q2 )
|
||||
! p > q and both are odd integers
|
||||
dup 1 = [ swap 2 + nip dup 2 - ] [ 2 - ] if ;
|
||||
dup 1 = [ drop 2 + dup ] when 2 - ;
|
||||
|
||||
: abc ( p q -- triplet )
|
||||
[
|
||||
2dup * , ! a = p * q
|
||||
2dup sq swap sq swap - 2 / , ! b = (p² - q²) / 2
|
||||
sq swap sq swap + 2 / , ! c = (p² + q²) / 2
|
||||
[ sq ] 2apply 2dup - 2 / , ! b = (p² - q²) / 2
|
||||
+ 2 / , ! c = (p² + q²) / 2
|
||||
] { } make natural-sort ;
|
||||
|
||||
: (ptriplet) ( target p q triplet -- target p q )
|
||||
roll dup >r swap sum = r> -roll
|
||||
[
|
||||
next-pq 2dup abc (ptriplet)
|
||||
] unless ;
|
||||
roll [ swap sum = ] keep -roll
|
||||
[ next-pq 2dup abc (ptriplet) ] unless ;
|
||||
|
||||
: ptriplet ( target -- triplet )
|
||||
3 1 { 3 4 5 } (ptriplet) abc nip ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer, Samuel Tardieu.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.primes sequences ;
|
||||
USING: math.primes sequences ;
|
||||
IN: project-euler.010
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=10
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ IN: project-euler.012
|
|||
dup 1+ * 2 / ;
|
||||
|
||||
: euler012 ( -- answer )
|
||||
2 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
|
||||
8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
|
||||
|
||||
! [ euler012 ] 10 ave-time
|
||||
! 5413 ms run / 1 ms GC ave time - 10 trials
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.parser sequences ;
|
||||
USING: math.parser sequences ;
|
||||
IN: project-euler.013
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=13
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ IN: project-euler.014
|
|||
dup even? [ 2 / ] [ 3 * 1+ ] if ;
|
||||
|
||||
: longest ( seq seq -- seq )
|
||||
2dup length swap length > [ nip ] [ drop ] if ;
|
||||
2dup [ length ] 2apply > [ drop ] [ nip ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -47,7 +47,7 @@ PRIVATE>
|
|||
[ [ dup 1 > ] [ dup , next-collatz ] [ ] while , ] { } make ;
|
||||
|
||||
: euler014 ( -- answer )
|
||||
1000000 0 [ 1+ collatz longest ] reduce first ;
|
||||
1000000 [1,b] 0 [ collatz longest ] reduce first ;
|
||||
|
||||
! [ euler014 ] time
|
||||
! 52868 ms run / 483 ms GC time
|
||||
|
|
@ -59,10 +59,7 @@ PRIVATE>
|
|||
<PRIVATE
|
||||
|
||||
: worth-calculating? ( n -- ? )
|
||||
{
|
||||
[ dup 1- 3 mod zero? ]
|
||||
[ dup 1- 3 / even? ]
|
||||
} && nip ;
|
||||
{ [ dup 1- 3 mod zero? ] [ dup 1- 3 / even? ] } && nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -72,7 +69,7 @@ PRIVATE>
|
|||
] reduce first ;
|
||||
|
||||
! [ euler014a ] 10 ave-time
|
||||
! 5109 ms run / 44 ms GC time
|
||||
! 4821 ms run / 41 ms GC time
|
||||
|
||||
! TODO: try using memoization
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.functions math.parser project-euler.common sequences ;
|
||||
USING: math.functions math.parser project-euler.common sequences ;
|
||||
IN: project-euler.016
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=16
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
|
||||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib kernel math math.ranges math.text namespaces sequences
|
||||
strings ;
|
||||
USING: combinators.lib kernel math.ranges math.text sequences strings ;
|
||||
IN: project-euler.017
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=17
|
||||
|
|
@ -23,55 +22,10 @@ IN: project-euler.017
|
|||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: units ( n -- )
|
||||
{
|
||||
"zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"
|
||||
"ten" "eleven" "twelve" "thirteen" "fourteen" "fifteen" "sixteen"
|
||||
"seventeen" "eighteen" "nineteen"
|
||||
} nth % ;
|
||||
|
||||
: tenths ( n -- )
|
||||
{
|
||||
f f "twenty" "thirty" "fourty" "fifty" "sixty" "seventy" "eighty" "ninety"
|
||||
} nth % ;
|
||||
|
||||
DEFER: make-english
|
||||
|
||||
: maybe-add ( n sep -- )
|
||||
over zero? [ 2drop ] [ % make-english ] if ;
|
||||
|
||||
: 0-99 ( n -- )
|
||||
dup 20 < [ units ] [ 10 /mod swap tenths "-" maybe-add ] if ;
|
||||
|
||||
: 0-999 ( n -- )
|
||||
100 /mod swap
|
||||
dup zero? [ drop 0-99 ] [ units " hundred" % " and " maybe-add ] if ;
|
||||
|
||||
: make-english ( n -- )
|
||||
1000 /mod swap
|
||||
dup zero? [ drop 0-999 ] [ 0-999 " thousand" % " and " maybe-add ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >english ( n -- str )
|
||||
[ make-english ] "" make ;
|
||||
|
||||
: euler017 ( -- answer )
|
||||
1000 [1,b] [ >english [ letter? ] subset length ] map sum ;
|
||||
|
||||
! [ euler017 ] 100 ave-time
|
||||
! 9 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
|
||||
! ALTERNATE SOLUTIONS
|
||||
! -------------------
|
||||
|
||||
: euler017a ( -- answer )
|
||||
1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
|
||||
|
||||
! [ euler017a ] 100 ave-time
|
||||
! 14 ms run / 1 ms GC ave time - 100 trials
|
||||
! 14 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler017
|
||||
|
|
|
|||
|
|
@ -50,9 +50,8 @@ IN: project-euler.018
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: pyramid ( -- seq )
|
||||
{
|
||||
75
|
||||
: source-018 ( -- triangle )
|
||||
{ 75
|
||||
95 64
|
||||
17 47 82
|
||||
18 35 87 10
|
||||
|
|
@ -67,22 +66,12 @@ IN: project-euler.018
|
|||
91 71 52 38 17 14 91 43 58 50 27 29 48
|
||||
63 66 04 68 89 53 67 30 73 16 69 87 40 31
|
||||
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
|
||||
}
|
||||
15 [ 1+ cut swap ] map nip ;
|
||||
} 15 [ 1+ cut swap ] map nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! Propagate one row into the upper one
|
||||
: propagate ( bottom top -- newtop )
|
||||
[ over 1 tail rot first2 max rot + ] map nip ;
|
||||
|
||||
! Not strictly needed, but it is nice to be able to dump the pyramid after
|
||||
! the propagation
|
||||
: propagate-all ( pyramid -- newpyramid )
|
||||
reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
|
||||
|
||||
: euler018 ( -- answer )
|
||||
pyramid propagate-all first first ;
|
||||
source-018 propagate-all first first ;
|
||||
|
||||
! [ euler018 ] 100 ave-time
|
||||
! 0 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
@ -91,31 +80,10 @@ PRIVATE>
|
|||
! ALTERNATE SOLUTIONS
|
||||
! -------------------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: source-018a ( -- triangle )
|
||||
{ { 75 }
|
||||
{ 95 64 }
|
||||
{ 17 47 82 }
|
||||
{ 18 35 87 10 }
|
||||
{ 20 04 82 47 65 }
|
||||
{ 19 01 23 75 03 34 }
|
||||
{ 88 02 77 73 07 63 67 }
|
||||
{ 99 65 04 28 06 16 70 92 }
|
||||
{ 41 41 26 56 83 40 80 70 33 }
|
||||
{ 41 48 72 33 47 32 37 16 94 29 }
|
||||
{ 53 71 44 65 25 43 91 52 97 51 14 }
|
||||
{ 70 11 33 28 77 73 17 78 39 68 17 57 }
|
||||
{ 91 71 52 38 17 14 91 43 58 50 27 29 48 }
|
||||
{ 63 66 04 68 89 53 67 30 73 16 69 87 40 31 }
|
||||
{ 04 62 98 27 23 09 70 98 73 93 38 53 60 04 23 } } ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler018a ( -- answer )
|
||||
source-018a max-path ;
|
||||
source-018 max-path ;
|
||||
|
||||
! [ euler018a ] 100 ave-time
|
||||
! 0 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
MAIN: euler018
|
||||
MAIN: euler018a
|
||||
|
|
|
|||
|
|
@ -30,9 +30,10 @@ IN: project-euler.019
|
|||
! already, as "zeller-congruence ( year month day -- n )" where n is
|
||||
! the day of the week (Sunday is 0).
|
||||
|
||||
: euler019 ( -- count )
|
||||
1901 2000 [a,b] [ 12 [1,b] [ 1 zeller-congruence ] 1 map-withn ] map concat
|
||||
[ 0 = ] subset length ;
|
||||
: euler019 ( -- answer )
|
||||
1901 2000 [a,b] [
|
||||
12 [1,b] [ 1 zeller-congruence ] 1 map-withn
|
||||
] map concat [ zero? ] count ;
|
||||
|
||||
! [ euler019 ] 100 ave-time
|
||||
! 1 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math.combinatorics math.parser project-euler.common sequences ;
|
||||
USING: math.combinatorics math.parser project-euler.common sequences ;
|
||||
IN: project-euler.020
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=20
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators.lib io io.files kernel math math.parser namespaces sequences
|
||||
sorting splitting strings system vocabs ;
|
||||
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
||||
strings system vocabs ;
|
||||
IN: project-euler.022
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=22
|
||||
|
|
@ -32,7 +32,7 @@ IN: project-euler.022
|
|||
file-contents [ quotable? ] subset "," split ;
|
||||
|
||||
: alpha-value ( str -- n )
|
||||
string>digits [ 9 - ] sigma ;
|
||||
[ string>digits sum ] keep length 9 * - ;
|
||||
|
||||
: name-scores ( seq -- seq )
|
||||
dup length [ 1+ swap alpha-value * ] 2map ;
|
||||
|
|
|
|||
|
|
@ -27,11 +27,11 @@ IN: project-euler.024
|
|||
: (>permutation) ( seq n -- seq )
|
||||
[ [ dupd >= [ 1+ ] when ] curry map ] keep add* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: >permutation ( factoradic -- permutation )
|
||||
reverse 1 cut [ (>permutation) ] each ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: factoradic ( k order -- factoradic )
|
||||
[ [1,b] [ 2dup mod , /i ] each ] { } make reverse nip ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax kernel math math.functions math.parser math.ranges memoize
|
||||
sequences ;
|
||||
project-euler.common sequences ;
|
||||
IN: project-euler.025
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=25
|
||||
|
|
@ -39,7 +39,7 @@ IN: project-euler.025
|
|||
! Memoized brute force
|
||||
|
||||
MEMO: fib ( m -- n )
|
||||
dup 1 > [ 1 - dup fib swap 1 - fib + ] when ;
|
||||
dup 1 > [ 1- dup fib swap 1- fib + ] when ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -67,8 +67,6 @@ PRIVATE>
|
|||
|
||||
<PRIVATE
|
||||
|
||||
FUNCTION: double log10 ( double x ) ;
|
||||
|
||||
: phi ( -- phi )
|
||||
5 sqrt 1+ 2 / ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.files kernel math.parser namespaces project-euler.018
|
||||
project-euler.common sequences splitting system vocabs ;
|
||||
USING: io.files math.parser namespaces project-euler.common sequences splitting ;
|
||||
IN: project-euler.067
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=67
|
||||
|
|
@ -39,7 +38,7 @@ IN: project-euler.067
|
|||
|
||||
: source-067 ( -- seq )
|
||||
"extra/project-euler/067/triangle.txt" resource-path
|
||||
<file-reader> lines [ " " split [ string>number ] map ] map ;
|
||||
file-lines [ " " split [ string>number ] map ] map ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
@ -57,7 +56,7 @@ PRIVATE>
|
|||
source-067 max-path ;
|
||||
|
||||
! [ euler067a ] 100 ave-time
|
||||
! 15 ms run / 0 ms GC ave time - 100 trials
|
||||
! 14 ms run / 0 ms GC ave time - 100 trials
|
||||
|
||||
! source-067 [ max-path ] curry 100 ave-time
|
||||
! 3 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Samuel Tardieu.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel lazy-lists math.algebra math math.functions math.primes
|
||||
math.ranges sequences ;
|
||||
math.ranges project-euler.common sequences ;
|
||||
IN: project-euler.134
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=134
|
||||
|
|
@ -9,23 +9,26 @@ IN: project-euler.134
|
|||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Consider the consecutive primes p1 = 19 and p2 = 23. It can be
|
||||
! verified that 1219 is the smallest number such that the last digits
|
||||
! are formed by p1 whilst also being divisible by p2.
|
||||
! Consider the consecutive primes p1 = 19 and p2 = 23. It can be verified that
|
||||
! 1219 is the smallest number such that the last digits are formed by p1 whilst
|
||||
! also being divisible by p2.
|
||||
|
||||
! In fact, with the exception of p1 = 3 and p2 = 5, for every pair of
|
||||
! consecutive primes, p2 p1, there exist values of n for which the last
|
||||
! digits are formed by p1 and n is divisible by p2. Let S be the
|
||||
! smallest of these values of n.
|
||||
! consecutive primes, p2 p1, there exist values of n for which the last digits
|
||||
! are formed by p1 and n is divisible by p2. Let S be the smallest of these
|
||||
! values of n.
|
||||
|
||||
! Find S for every pair of consecutive primes with 5 p1 1000000.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
! Compute the smallest power of 10 greater than m or equal to it
|
||||
! Compute the smallest power of 10 greater than or equal to m
|
||||
: next-power-of-10 ( m -- n )
|
||||
10 swap log 10 log / ceiling >integer ^ ; foldable
|
||||
10 swap log10 ceiling >integer ^ ; foldable
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! Compute S for a given pair (p1, p2) -- that is the smallest positive
|
||||
! number such that X = p1 [npt] and X = 0 [p2] (npt being the smallest
|
||||
|
|
@ -33,10 +36,13 @@ IN: project-euler.134
|
|||
: s ( p1 p2 -- s )
|
||||
over 0 2array rot next-power-of-10 rot 2array chinese-remainder ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler134 ( -- answer )
|
||||
0 5 lprimes-from uncons [ 1000000 > ] luntil [ [ s + ] keep ] leach drop ;
|
||||
0 5 lprimes-from uncons [ 1000000 > ] luntil
|
||||
[ [ s + ] keep ] leach drop ;
|
||||
|
||||
! [ euler134 ] 10 ave-time
|
||||
! 3797 ms run / 30 ms GC ave time - 10 trials
|
||||
! 2430 ms run / 36 ms GC ave time - 10 trials
|
||||
|
||||
MAIN: euler134
|
||||
|
|
|
|||
|
|
@ -8,11 +8,11 @@ USING: combinators kernel math math.functions memoize ;
|
|||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Define f(0)=1 and f(n) to be the number of different ways n can be
|
||||
! expressed as a sum of integer powers of 2 using each power no more
|
||||
! than twice.
|
||||
! Define f(0) = 1 and f(n) to be the number of different ways n can be
|
||||
! expressed as a sum of integer powers of 2 using each power no more than
|
||||
! twice.
|
||||
|
||||
! For example, f(10)=5 since there are five different ways to express 10:
|
||||
! For example, f(10) = 5 since there are five different ways to express 10:
|
||||
|
||||
! 1 + 1 + 8
|
||||
! 1 + 1 + 4 + 4
|
||||
|
|
@ -22,6 +22,7 @@ USING: combinators kernel math math.functions memoize ;
|
|||
|
||||
! What is f(1025)?
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! Copyright (c) 2007 Samuel Tardieu.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.ranges sequences ;
|
||||
IN: project-euler.173
|
||||
|
|
@ -8,25 +8,29 @@ IN: project-euler.173
|
|||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! We shall define a square lamina to be a square outline with a square
|
||||
! "hole" so that the shape possesses vertical and horizontal
|
||||
! symmetry. For example, using exactly thirty-two square tiles we can
|
||||
! form two different square laminae: [see URL for figure]
|
||||
! We shall define a square lamina to be a square outline with a square "hole"
|
||||
! so that the shape possesses vertical and horizontal symmetry. For example,
|
||||
! using exactly thirty-two square tiles we can form two different square
|
||||
! laminae: [see URL for figure]
|
||||
|
||||
! With one-hundred tiles, and not necessarily using all of the tiles at
|
||||
! one time, it is possible to form forty-one different square laminae.
|
||||
! With one-hundred tiles, and not necessarily using all of the tiles at one
|
||||
! time, it is possible to form forty-one different square laminae.
|
||||
|
||||
! Using up to one million tiles how many different square laminae can be formed?
|
||||
|
||||
! Using up to one million tiles how many different square laminae can be
|
||||
! formed?
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
: laminaes ( upper -- n )
|
||||
4 / dup sqrt [1,b] 0 rot [ over /mod drop - - ] curry reduce ;
|
||||
<PRIVATE
|
||||
|
||||
: laminae ( upper -- n )
|
||||
4 / dup sqrt [1,b] 0 rot [ over /i - - ] curry reduce ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler173 ( -- answer )
|
||||
1000000 laminaes ;
|
||||
1000000 laminae ;
|
||||
|
||||
! [ euler173 ] 100 ave-time
|
||||
! 0 ms run / 0 ms GC ave time - 100 trials
|
||||
|
|
|
|||
|
|
@ -8,29 +8,31 @@ IN: project-euler.175
|
|||
! DESCRIPTION
|
||||
! -----------
|
||||
|
||||
! Define f(0)=1 and f(n) to be the number of ways to write n as a sum of
|
||||
! Define f(0) = 1 and f(n) to be the number of ways to write n as a sum of
|
||||
! powers of 2 where no power occurs more than twice.
|
||||
|
||||
! For example, f(10)=5 since there are five different ways to express
|
||||
! For example, f(10) = 5 since there are five different ways to express
|
||||
! 10: 10 = 8+2 = 8+1+1 = 4+4+2 = 4+2+2+1+1 = 4+4+1+1
|
||||
|
||||
! It can be shown that for every fraction p/q (p0, q0) there exists at
|
||||
! least one integer n such that f(n)/f(n-1)=p/q.
|
||||
! It can be shown that for every fraction p/q (p0, q0) there exists at least
|
||||
! one integer n such that f(n) / f(n-1) = p/q.
|
||||
|
||||
! For instance, the smallest n for which f(n)/f(n-1)=13/17 is 241. The
|
||||
! binary expansion of 241 is 11110001. Reading this binary number from
|
||||
! the most significant bit to the least significant bit there are 4
|
||||
! one's, 3 zeroes and 1 one. We shall call the string 4,3,1 the
|
||||
! Shortened Binary Expansion of 241.
|
||||
! For instance, the smallest n for which f(n) / f(n-1) = 13/17 is 241. The
|
||||
! binary expansion of 241 is 11110001. Reading this binary number from the most
|
||||
! significant bit to the least significant bit there are 4 one's, 3 zeroes and
|
||||
! 1 one. We shall call the string 4,3,1 the Shortened Binary Expansion of 241.
|
||||
|
||||
! Find the Shortened Binary Expansion of the smallest n for which
|
||||
! f(n)/f(n-1)=123456789/987654321.
|
||||
! f(n) / f(n-1) = 123456789/987654321.
|
||||
|
||||
! Give your answer as comma separated integers, without any whitespaces.
|
||||
|
||||
|
||||
! SOLUTION
|
||||
! --------
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: add-bits ( vec n b -- )
|
||||
over zero? [
|
||||
3drop
|
||||
|
|
@ -45,6 +47,8 @@ IN: project-euler.175
|
|||
{ [ t ] [ [ 1 mod compute ] 2keep >integer 0 add-bits ] }
|
||||
} cond ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: euler175 ( -- result )
|
||||
V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,31 +1,51 @@
|
|||
USING: arrays kernel hashtables math math.functions math.miller-rabin
|
||||
math.parser math.ranges namespaces sequences combinators.lib ;
|
||||
USING: kernel math math.functions math.miller-rabin math.parser
|
||||
math.primes.factors math.ranges namespaces sequences ;
|
||||
IN: project-euler.common
|
||||
|
||||
! A collection of words used by more than one Project Euler solution.
|
||||
! A collection of words used by more than one Project Euler solution
|
||||
! and/or related words that could be useful for future problems.
|
||||
|
||||
! Problems using each public word
|
||||
! -------------------------------
|
||||
! collect-consecutive - #8, #11
|
||||
! log10 - #25, #134
|
||||
! max-path - #18, #67
|
||||
! number>digits - #16, #20
|
||||
! propagate-all - #18, #67
|
||||
! sum-proper-divisors - #21
|
||||
! tau* - #12
|
||||
|
||||
|
||||
: nth-pair ( n seq -- nth next )
|
||||
over 1+ over nth >r nth r> ;
|
||||
|
||||
: perfect-square? ( n -- ? )
|
||||
dup sqrt mod zero? ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: count-shifts ( seq width -- n )
|
||||
>r length 1+ r> - ;
|
||||
|
||||
: shift-3rd ( seq obj obj -- seq obj obj )
|
||||
rot 1 tail -rot ;
|
||||
|
||||
: max-children ( seq -- seq )
|
||||
[ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
|
||||
|
||||
: >multiplicity ( seq -- seq )
|
||||
dup prune [
|
||||
[ 2dup [ = ] curry count 2array , ] each
|
||||
] { } make nip ; inline
|
||||
! Propagate one row into the upper one
|
||||
: propagate ( bottom top -- newtop )
|
||||
[ over 1 tail rot first2 max rot + ] map nip ;
|
||||
|
||||
: reduce-2s ( n -- r s )
|
||||
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
|
||||
|
||||
: shift-3rd ( seq obj obj -- seq obj obj )
|
||||
rot 1 tail -rot ;
|
||||
|
||||
: (sum-divisors) ( n -- sum )
|
||||
dup sqrt >fixnum [1,b] [
|
||||
[ 2dup mod zero? [ 2dup / + , ] [ drop ] if ] each
|
||||
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
|
||||
] { } make sum ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: collect-consecutive ( seq width -- seq )
|
||||
|
|
@ -33,8 +53,8 @@ PRIVATE>
|
|||
2dup count-shifts [ 2dup head shift-3rd , ] times
|
||||
] { } make 2nip ;
|
||||
|
||||
: divisor? ( n m -- ? )
|
||||
mod zero? ;
|
||||
: log10 ( m -- n )
|
||||
log 10 log / ;
|
||||
|
||||
: max-path ( triangle -- n )
|
||||
dup length 1 > [
|
||||
|
|
@ -46,27 +66,10 @@ PRIVATE>
|
|||
: number>digits ( n -- seq )
|
||||
number>string string>digits ;
|
||||
|
||||
: perfect-square? ( n -- ? )
|
||||
dup sqrt divisor? ;
|
||||
|
||||
: prime-factorization ( n -- seq )
|
||||
[
|
||||
2 [ over 1 > ]
|
||||
[ 2dup divisor? [ dup , [ / ] keep ] [ next-prime ] if ]
|
||||
[ ] while 2drop
|
||||
] { } make ;
|
||||
|
||||
: prime-factorization* ( n -- seq )
|
||||
prime-factorization >multiplicity ;
|
||||
|
||||
: prime-factors ( n -- seq )
|
||||
prime-factorization prune >array ;
|
||||
|
||||
: (sum-divisors) ( n -- sum )
|
||||
dup sqrt >fixnum [1,b] [
|
||||
[ 2dup divisor? [ 2dup / + , ] [ drop ] if ] each
|
||||
dup perfect-square? [ sqrt >fixnum neg , ] [ drop ] if
|
||||
] { } make sum ;
|
||||
! Not strictly needed, but it is nice to be able to dump the triangle after the
|
||||
! propagation
|
||||
: propagate-all ( triangle -- newtriangle )
|
||||
reverse [ first dup ] keep 1 tail [ propagate dup ] map nip reverse swap add ;
|
||||
|
||||
: sum-divisors ( n -- sum )
|
||||
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
|
||||
|
|
@ -84,12 +87,12 @@ PRIVATE>
|
|||
dup sum-proper-divisors = ;
|
||||
|
||||
! The divisor function, counts the number of divisors
|
||||
: tau ( n -- n )
|
||||
prime-factorization* flip second 1 [ 1+ * ] reduce ;
|
||||
: tau ( m -- n )
|
||||
count-factors flip second 1 [ 1+ * ] reduce ;
|
||||
|
||||
! Optimized brute-force, is often faster than prime factorization
|
||||
: tau* ( n -- n )
|
||||
: tau* ( m -- n )
|
||||
reduce-2s [ perfect-square? -1 0 ? ] keep
|
||||
dup sqrt >fixnum [1,b] [
|
||||
dupd divisor? [ >r 2 + r> ] when
|
||||
dupd mod zero? [ >r 2 + r> ] when
|
||||
] each drop * ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue