-! Copyright (C) 2008 Doug Coleman, Slava Pestov.
+! Copyright (C) 2008 Doug Coleman, Slava Pestov, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.constants math.functions math.intervals
-math.vectors namespaces sequences combinators.short-circuit ;
+USING: combinators.short-circuit kernel math math.constants math.functions
+ math.vectors sequences ;
IN: math.analysis
<PRIVATE
: gamma-p6
{
2.50662827563479526904 225.525584619175212544 -268.295973841304927459
- 80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556
+ 80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556
} ; inline
: gamma-z ( x n -- seq )
: (gamma-lanczos6) ( x -- log[gamma[x+1]] )
#! log(gamma(x+1)
- [ 0.5 + dup gamma-g6 + dup [ log * ] dip - ]
+ [ 0.5 + dup gamma-g6 + [ log * ] keep - ]
[ 6 gamma-z gamma-p6 v. log ] bi + ;
: gamma-lanczos6 ( x -- gamma[x] )
#! gamma(x) = gamma(x+1) / x
- dup (gamma-lanczos6) exp swap / ;
+ [ (gamma-lanczos6) exp ] keep / ;
: gammaln-lanczos6 ( x -- gammaln[x] )
#! log(gamma(x)) = log(gamma(x+1)) - log(x)
- dup (gamma-lanczos6) swap log - ;
+ [ (gamma-lanczos6) ] keep log - ;
: gamma-neg ( gamma[abs[x]] x -- gamma[x] )
dup pi * sin * * pi neg swap / ; inline
#! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt
#! gamma(n+1) = n! for n > 0
dup { [ 0.0 <= ] [ 1.0 mod zero? ] } 1&& [
- drop 1./0.
- ] [
- dup abs gamma-lanczos6 swap dup 0 > [ drop ] [ gamma-neg ] if
+ drop 1./0.
+ ] [
+ [ abs gamma-lanczos6 ] keep dup 0 > [ drop ] [ gamma-neg ] if
] if ;
: gammaln ( x -- gamma[x] )
#! gammaln(x) is an alternative when gamma(x)'s range
#! varies too widely
dup 0 < [
- drop 1./0.
- ] [
- dup abs gammaln-lanczos6 swap dup 0 > [ drop ] [ gamma-neg ] if
+ drop 1./0.
+ ] [
+ [ abs gammaln-lanczos6 ] keep dup 0 > [ drop ] [ gamma-neg ] if
] if ;
: nth-root ( n x -- y )
- [ recip ] dip swap ^ ;
+ swap recip ^ ;
! Forth Scientific Library Algorithm #1
!
: stirling-fact ( n -- fact )
[ pi 2 * * sqrt ]
- [ dup e / swap ^ ]
- [ 12 * recip 1 + ]
- tri * * ;
+ [ [ e / ] keep ^ ]
+ [ 12 * recip 1+ ] tri * * ;
+
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.functions math.parser namespaces
-sequences splitting grouping combinators.short-circuit ;
+USING: combinators.short-circuit grouping kernel math math.parser namespaces
+ sequences ;
IN: math.text.english
<PRIVATE
] if ;
: 3digits>text ( n -- str )
- dup hundreds-place swap tens-place append ;
+ [ hundreds-place ] [ tens-place ] bi append ;
: text-with-scale ( index seq -- str )
- dupd nth 3digits>text swap
- scale-numbers [
- " " swap 3append
- ] unless-empty ;
+ [ nth 3digits>text ] [ drop scale-numbers ] 2bi
+ [ " " swap 3append ] unless-empty ;
: append-with-conjunction ( str1 str2 -- newstr )
over length zero? [
and-needed? off
] if ;
-: (recombine) ( str index seq -- newstr seq )
+: (recombine) ( str index seq -- newstr )
2dup nth zero? [
- nip
+ 2drop
] [
- [ text-with-scale ] keep
- -rot append-with-conjunction swap
+ text-with-scale append-with-conjunction
] if ;
: recombine ( seq -- str )
dup length 1 = [
first 3digits>text
] [
- dup set-conjunction "" swap
- dup length [ swap (recombine) ] each drop
+ [ set-conjunction "" ] [ length ] [ ] tri
+ [ (recombine) ] curry each
] if ;
: (number>text) ( n -- str )
--- /dev/null
+USING: project-euler.001 tools.test ;
+IN: project-euler.001.tests
+
+[ 233168 ] [ euler001 ] unit-test
+[ 233168 ] [ euler001a ] unit-test
+[ 233168 ] [ euler001b ] unit-test
--- /dev/null
+USING: project-euler.002 tools.test ;
+IN: project-euler.002.tests
+
+[ 4613732 ] [ euler002 ] unit-test
+[ 4613732 ] [ euler002a ] unit-test
! 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
-! Find the sum of all the even-valued terms in the sequence which do not exceed one million.
+! Find the sum of all the even-valued terms in the sequence which do not exceed
+! four million.
! SOLUTION
V{ 0 } clone 1 rot (fib-upto) ;
: euler002 ( -- answer )
- 1000000 fib-upto [ even? ] filter sum ;
+ 4000000 fib-upto [ even? ] filter sum ;
! [ euler002 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.22 SD (100 trials)
! ALTERNATE SOLUTIONS
but-last-slice { 0 1 } prepend ;
: euler002a ( -- answer )
- 1000000 fib-upto* [ even? ] filter sum ;
+ 4000000 fib-upto* [ even? ] filter sum ;
! [ euler002a ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.2 SD (100 trials)
MAIN: euler002a
--- /dev/null
+USING: project-euler.003 tools.test ;
+IN: project-euler.003.tests
+
+[ 6857 ] [ euler003 ] unit-test
! The prime factors of 13195 are 5, 7, 13 and 29.
-! What is the largest prime factor of the number 317584931803?
+! What is the largest prime factor of the number 600851475143 ?
! SOLUTION
! --------
: euler003 ( -- answer )
- 317584931803 factors supremum ;
+ 600851475143 factors supremum ;
! [ euler003 ] 100 ave-time
-! 1 ms run / 0 ms GC ave time - 100 trials
+! 1 ms ave run time - 0.49 SD (100 trials)
MAIN: euler003
--- /dev/null
+USING: project-euler.004 tools.test ;
+IN: project-euler.004.tests
+
+[ 906609 ] [ euler004 ] unit-test
source-004 dup cartesian-product [ product ] map prune max-palindrome ;
! [ euler004 ] 100 ave-time
-! 1608 ms run / 102 ms GC ave time - 100 trials
+! 1164 ms ave run time - 39.35 SD (100 trials)
MAIN: euler004
--- /dev/null
+USING: project-euler.005 tools.test ;
+IN: project-euler.005.tests
+
+[ 232792560 ] [ euler005 ] unit-test
20 1 [ 1+ lcm ] reduce ;
! [ euler005 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.14 SD (100 trials)
MAIN: euler005
--- /dev/null
+USING: project-euler.006 tools.test ;
+IN: project-euler.006.tests
+
+[ 25164150 ] [ euler006 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions math.ranges sequences ;
+USING: kernel math math.ranges sequences ;
IN: project-euler.006
! http://projecteuler.net/index.php?section=problems&id=6
PRIVATE>
: euler006 ( -- answer )
- 1 100 [a,b] dup sum-of-squares swap square-of-sum - abs ;
+ 100 [1,b] [ sum-of-squares ] [ square-of-sum ] bi - abs ;
! [ euler006 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.24 SD (100 trials)
MAIN: euler006
--- /dev/null
+USING: project-euler.007 tools.test ;
+IN: project-euler.007.tests
+
+[ 104743 ] [ euler007 ] unit-test
10001 nth-prime ;
! [ euler007 ] 100 ave-time
-! 10 ms run / 0 ms GC ave time - 100 trials
+! 5 ms ave run time - 1.13 SD (100 trials)
MAIN: euler007
--- /dev/null
+USING: project-euler.008 tools.test ;
+IN: project-euler.008.tests
+
+[ 40824 ] [ euler008 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: math.parser project-euler.common sequences ;
+USING: grouping math.parser sequences ;
IN: project-euler.008
! http://projecteuler.net/index.php?section=problems&id=8
PRIVATE>
: euler008 ( -- answer )
- source-008 5 collect-consecutive [ string>digits product ] map supremum ;
+ source-008 5 clump [ string>digits product ] map supremum ;
! [ euler008 ] 100 ave-time
-! 11 ms run / 0 ms GC ave time - 100 trials
+! 2 ms ave run time - 0.79 SD (100 trials)
MAIN: euler008
--- /dev/null
+USING: project-euler.009 tools.test ;
+IN: project-euler.009.tests
+
+[ 31875000 ] [ euler009 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions namespaces make sequences sorting ;
+USING: kernel make math sequences sorting ;
IN: project-euler.009
! http://projecteuler.net/index.php?section=problems&id=9
: abc ( p q -- triplet )
[
- 2dup * , ! a = p * q
- [ sq ] bi@ 2dup - 2 / , ! b = (p² - q²) / 2
- + 2 / , ! c = (p² + q²) / 2
+ 2dup * , ! a = p * q
+ [ sq ] bi@
+ [ - 2 / , ] ! b = (p² - q²) / 2
+ [ + 2 / , ] 2bi ! c = (p² + q²) / 2
] { } make natural-sort ;
: (ptriplet) ( target p q triplet -- target p q )
- roll [ swap sum = ] keep -roll
- [ next-pq 2dup abc (ptriplet) ] unless ;
+ sum [ pick ] dip = [ next-pq 2dup abc (ptriplet) ] unless ;
: ptriplet ( target -- triplet )
3 1 { 3 4 5 } (ptriplet) abc nip ;
1000 ptriplet product ;
! [ euler009 ] 100 ave-time
-! 1 ms run / 0 ms GC ave time - 100 trials
+! 1 ms ave run time - 0.73 SD (100 trials)
MAIN: euler009
--- /dev/null
+USING: project-euler.010 tools.test ;
+IN: project-euler.010.tests
+
+[ 142913828922 ] [ euler010 ] unit-test
! The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
-! Find the sum of all the primes below one million.
+! Find the sum of all the primes below two million.
! SOLUTION
! --------
: euler010 ( -- answer )
- 1000000 primes-upto sum ;
+ 2000000 primes-upto sum ;
-! [ euler010 ] 100 ave-time
-! 14 ms run / 0 ms GC ave time - 100 trials
+! [ euler010 ] time
+! 266425 ms run / 10001 ms GC time
+
+! TODO: this takes well over one minute now that they changed the problem to
+! two million instead of one. the primes vocab could use some improvements
MAIN: euler010
--- /dev/null
+USING: project-euler.011 tools.test ;
+IN: project-euler.011.tests
+
+[ 70600674 ] [ euler011 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces make project-euler.common sequences
-splitting grouping ;
+USING: grouping kernel make sequences ;
IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11
horizontal pad-front pad-back flip ;
: max-product ( matrix width -- n )
- [ collect-consecutive ] curry map concat
+ [ clump ] curry map concat
[ product ] map supremum ; inline
PRIVATE>
] { } make supremum ;
! [ euler011 ] 100 ave-time
-! 4 ms run / 0 ms GC ave time - 100 trials
+! 3 ms ave run time - 0.77 SD (100 trials)
MAIN: euler011
--- /dev/null
+USING: project-euler.012 tools.test ;
+IN: project-euler.012.tests
+
+[ 76576500 ] [ euler012 ] unit-test
8 [ dup nth-triangle tau* 500 < ] [ 1+ ] [ ] while nth-triangle ;
! [ euler012 ] 10 ave-time
-! 5413 ms run / 1 ms GC ave time - 10 trials
+! 6573 ms ave run time - 346.27 SD (10 trials)
MAIN: euler012
--- /dev/null
+USING: project-euler.013 tools.test ;
+IN: project-euler.013.tests
+
+[ 5537376230 ] [ euler013 ] unit-test
source-013 sum number>string 10 head string>number ;
! [ euler013 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.31 SD (100 trials)
MAIN: euler013
--- /dev/null
+USING: project-euler.014 tools.test ;
+IN: project-euler.014.tests
+
+[ 837799 ] [ euler014 ] unit-test
+[ 837799 ] [ euler014a ] unit-test
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators.short-circuit kernel
-math math.ranges namespaces make sequences sorting ;
+USING: combinators.short-circuit kernel make math math.ranges sequences ;
IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14
<PRIVATE
: worth-calculating? ( n -- ? )
- { [ dup 1- 3 mod zero? ] [ dup 1- 3 / even? ] } 0&& nip ;
+ 1- 3 { [ mod zero? ] [ / even? ] } 2&& ;
PRIVATE>
--- /dev/null
+USING: project-euler.015 tools.test ;
+IN: project-euler.015.tests
+
+[ 137846528820 ] [ euler015 ] unit-test
20 grid-paths ;
! [ euler015 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.2 SD (100 trials)
MAIN: euler015
--- /dev/null
+USING: project-euler.016 tools.test ;
+IN: project-euler.016.tests
+
+[ 1366 ] [ euler016 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: math.functions math.parser project-euler.common sequences ;
+USING: math.functions project-euler.common sequences ;
IN: project-euler.016
! http://projecteuler.net/index.php?section=problems&id=16
2 1000 ^ number>digits sum ;
! [ euler016 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.67 SD (100 trials)
MAIN: euler016
--- /dev/null
+USING: project-euler.017 tools.test ;
+IN: project-euler.017.tests
+
+[ 21124 ] [ euler017 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.ranges math.text.english sequences strings
- ascii combinators.short-circuit ;
+USING: ascii kernel math.ranges math.text.english sequences ;
IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17
: euler017 ( -- answer )
1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
-! [ euler017a ] 100 ave-time
-! 14 ms run / 0 ms GC ave time - 100 trials
+! [ euler017 ] 100 ave-time
+! 15 ms ave run time - 1.71 SD (100 trials)
MAIN: euler017
--- /dev/null
+USING: project-euler.018 tools.test ;
+IN: project-euler.018.tests
+
+[ 1074 ] [ euler018 ] unit-test
+[ 1074 ] [ euler018a ] unit-test
source-018 propagate-all first first ;
! [ euler018 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.29 SD (100 trials)
! ALTERNATE SOLUTIONS
source-018 max-path ;
! [ euler018a ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.39 SD (100 trials)
MAIN: euler018a
--- /dev/null
+USING: project-euler.019 tools.test ;
+IN: project-euler.019.tests
+
+[ 171 ] [ euler019 ] unit-test
+[ 171 ] [ euler019a ] unit-test
] map concat [ zero? ] count ;
! [ euler019 ] 100 ave-time
-! 1 ms run / 0 ms GC ave time - 100 trials
+! 1 ms ave run time - 0.51 SD (100 trials)
! ALTERNATE SOLUTIONS
end-date start-date first-days [ zero? ] count ;
! [ euler019a ] 100 ave-time
-! 131 ms run / 3 ms GC ave time - 100 trials
+! 17 ms ave run time - 2.13 SD (100 trials)
MAIN: euler019
--- /dev/null
+USING: project-euler.020 tools.test ;
+IN: project-euler.020.tests
+
+[ 648 ] [ euler020 ] unit-test
-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: math.combinatorics math.parser project-euler.common sequences ;
+USING: math.combinatorics project-euler.common sequences ;
IN: project-euler.020
! http://projecteuler.net/index.php?section=problems&id=20
100 factorial number>digits sum ;
! [ euler020 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.55 (100 trials)
MAIN: euler020
--- /dev/null
+USING: project-euler.021 tools.test ;
+IN: project-euler.021.tests
+
+[ 31626 ] [ euler021 ] unit-test
: amicable? ( n -- ? )
dup sum-proper-divisors
- { [ 2dup = not ] [ 2dup sum-proper-divisors = ] } 0&& 2nip ;
+ { [ = not ] [ sum-proper-divisors = ] } 2&& ;
: euler021 ( -- answer )
10000 [1,b] [ dup amicable? [ drop 0 ] unless ] sigma ;
! [ euler021 ] 100 ave-time
-! 328 ms run / 10 ms GC ave time - 100 trials
+! 335 ms ave run time - 18.63 SD (100 trials)
MAIN: euler021
--- /dev/null
+USING: project-euler.022 tools.test ;
+IN: project-euler.022.tests
+
+[ 871198282 ] [ euler022 ] unit-test
source-022 natural-sort name-scores sum ;
! [ euler022 ] 100 ave-time
-! 123 ms run / 4 ms GC ave time - 100 trials
+! 74 ms ave run time - 5.13 SD (100 trials)
MAIN: euler022
--- /dev/null
+USING: project-euler.023 tools.test ;
+IN: project-euler.023.tests
+
+[ 4179871 ] [ euler023 ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables kernel math math.ranges project-euler.common sequences
- sorting sets ;
+USING: kernel math math.ranges project-euler.common sequences sets sorting ;
IN: project-euler.023
! http://projecteuler.net/index.php?section=problems&id=23
--- /dev/null
+USING: project-euler.024 tools.test ;
+IN: project-euler.024.tests
+
+[ 2783915460 ] [ euler024 ] unit-test
999999 10 permutation 10 digits>integer ;
! [ euler024 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.27 SD (100 trials)
MAIN: euler024
--- /dev/null
+USING: project-euler.025 tools.test ;
+IN: project-euler.025.tests
+
+[ 4782 ] [ euler025 ] unit-test
+[ 4782 ] [ euler025a ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel math math.constants math.functions math.parser
- math.ranges memoize project-euler.common sequences ;
+USING: kernel math math.constants math.functions math.parser memoize
+ project-euler.common sequences ;
IN: project-euler.025
! http://projecteuler.net/index.php?section=problems&id=25
1000 digit-fib ;
! [ euler025 ] 10 ave-time
-! 5237 ms run / 72 ms GC ave time - 10 trials
+! 5345 ms ave run time - 105.91 SD (10 trials)
! ALTERNATE SOLUTIONS
1000 digit-fib* ;
! [ euler025a ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.17 SD (100 trials)
MAIN: euler025a
--- /dev/null
+USING: project-euler.026 tools.test ;
+IN: project-euler.026.tests
+
+[ 983 ] [ euler026 ] unit-test
source-026 max-period drop denominator ;
! [ euler026 ] 100 ave-time
-! 724 ms run / 7 ms GC ave time - 100 trials
+! 290 ms ave run time - 19.2 SD (100 trials)
MAIN: euler026
--- /dev/null
+USING: project-euler.027 tools.test ;
+IN: project-euler.027.tests
+
+[ -59231 ] [ euler027 ] unit-test
source-027 max-consecutive drop product ;
! [ euler027 ] 100 ave-time
-! 687 ms run / 23 ms GC ave time - 100 trials
+! 111 ms ave run time - 6.07 SD (100 trials)
! TODO: generalize max-consecutive/max-product (from #26) into a new word
--- /dev/null
+USING: project-euler.028 tools.test ;
+IN: project-euler.028.tests
+
+[ 669171001 ] [ euler028 ] unit-test
<PRIVATE
: sum-corners ( n -- sum )
- dup 1 = [ [ sq 4 * ] keep 6 * - 6 + ] unless ;
+ dup 1 = [ [ sq 4 * ] [ 6 * ] bi - 6 + ] unless ;
: sum-diags ( n -- sum )
1 swap 2 <range> [ sum-corners ] sigma ;
1001 sum-diags ;
! [ euler028 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.39 SD (100 trials)
MAIN: euler028
--- /dev/null
+USING: project-euler.029 tools.test ;
+IN: project-euler.029.tests
+
+[ 9183 ] [ euler029 ] unit-test
2 100 [a,b] dup cartesian-product [ first2 ^ ] map prune length ;
! [ euler029 ] 100 ave-time
-! 951 ms run / 12 ms GC ave time - 100 trials
+! 704 ms ave run time - 28.07 SD (100 trials)
MAIN: euler029
--- /dev/null
+USING: project-euler.030 tools.test ;
+IN: project-euler.030.tests
+
+[ 443839 ] [ euler030 ] unit-test
325537 [ dup sum-fifth-powers = ] filter sum 1- ;
! [ euler030 ] 100 ave-time
-! 2537 ms run / 125 ms GC ave time - 100 trials
+! 1700 ms ave run time - 64.84 SD (100 trials)
MAIN: euler030
--- /dev/null
+USING: project-euler.031 tools.test ;
+IN: project-euler.031.tests
+
+[ 73682 ] [ euler031 ] unit-test
drop 1 ;
: 2p ( m -- n )
- dup 0 >= [ [ 2 - 2p ] keep 1p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 2 - 2p ] [ 1p ] bi + ] [ drop 0 ] if ;
: 5p ( m -- n )
- dup 0 >= [ [ 5 - 5p ] keep 2p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 5 - 5p ] [ 2p ] bi + ] [ drop 0 ] if ;
: 10p ( m -- n )
- dup 0 >= [ [ 10 - 10p ] keep 5p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 10 - 10p ] [ 5p ] bi + ] [ drop 0 ] if ;
: 20p ( m -- n )
- dup 0 >= [ [ 20 - 20p ] keep 10p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 20 - 20p ] [ 10p ] bi + ] [ drop 0 ] if ;
: 50p ( m -- n )
- dup 0 >= [ [ 50 - 50p ] keep 20p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 50 - 50p ] [ 20p ] bi + ] [ drop 0 ] if ;
: 100p ( m -- n )
- dup 0 >= [ [ 100 - 100p ] keep 50p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 100 - 100p ] [ 50p ] bi + ] [ drop 0 ] if ;
: 200p ( m -- n )
- dup 0 >= [ [ 200 - 200p ] keep 100p + ] [ drop 0 ] if ;
+ dup 0 >= [ [ 200 - 200p ] [ 100p ] bi + ] [ drop 0 ] if ;
PRIVATE>
200 200p ;
! [ euler031 ] 100 ave-time
-! 4 ms run / 0 ms GC ave time - 100 trials
+! 3 ms ave run time - 0.91 SD (100 trials)
! TODO: generalize to eliminate duplication; use a sequence to specify denominations?
--- /dev/null
+USING: project-euler.032 tools.test ;
+IN: project-euler.032.tests
+
+[ 45228 ] [ euler032 ] unit-test
+[ 45228 ] [ euler032a ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables kernel math math.combinatorics math.functions
- math.parser math.ranges project-euler.common sequences sets ;
+USING: kernel math math.combinatorics math.functions math.parser math.ranges
+ project-euler.common sequences sets ;
IN: project-euler.032
! http://projecteuler.net/index.php?section=problems&id=32
[ string>number ] tri@ [ * ] dip = ;
: valid? ( n -- ? )
- dup 1and4 swap 2and3 or ;
+ [ 1and4 ] [ 2and3 ] bi or ;
: products ( seq -- m )
[ 10 4 ^ mod ] map ;
source-032 [ valid? ] filter products prune sum ;
! [ euler032 ] 10 ave-time
-! 23922 ms run / 1505 ms GC ave time - 10 trials
+! 16361 ms ave run time - 417.8 SD (10 trials)
! ALTERNATE SOLUTIONS
: euler032a ( -- answer )
source-032a [ mmp ] map [ pandigital? ] filter products prune sum ;
-! [ euler032a ] 100 ave-time
-! 5978 ms run / 327 ms GC ave time - 100 trials
+! [ euler032a ] 10 ave-time
+! 2624 ms ave run time - 131.91 SD (10 trials)
MAIN: euler032a
--- /dev/null
+USING: project-euler.033 tools.test ;
+IN: project-euler.033.tests
+
+[ 100 ] [ euler033 ] unit-test
source-033 curious-fractions product denominator ;
! [ euler033 ] 100 ave-time
-! 5 ms run / 0 ms GC ave time - 100 trials
+! 7 ms ave run time - 1.31 SD (100 trials)
MAIN: euler033
--- /dev/null
+USING: project-euler.034 tools.test ;
+IN: project-euler.034.tests
+
+[ 40730 ] [ euler034 ] unit-test
3 2000000 [a,b] [ factorion? ] filter sum ;
! [ euler034 ] 10 ave-time
-! 15089 ms run / 725 ms GC ave time - 10 trials
+! 5506 ms ave run time - 144.0 SD (10 trials)
MAIN: euler034
--- /dev/null
+USING: project-euler.035 tools.test ;
+IN: project-euler.035.tests
+
+[ 55 ] [ euler035 ] unit-test
source-035 [ possible? ] filter [ circular? ] count ;
! [ euler035 ] 100 ave-time
-! 904 ms run / 86 ms GC ave time - 100 trials
+! 538 ms ave run time - 17.16 SD (100 trials)
! TODO: try using bit arrays or other methods outlined here:
! http://home.comcast.net/~babdulbaki/Circular_Primes.html
--- /dev/null
+USING: project-euler.036 tools.test ;
+IN: project-euler.036.tests
+
+[ 872187 ] [ euler036 ] unit-test
<PRIVATE
: both-bases? ( n -- ? )
- { [ dup palindrome? ]
- [ dup >bin dup reverse = ] } 0&& nip ;
+ { [ palindrome? ] [ >bin dup reverse = ] } 1&& ;
PRIVATE>
1 1000000 2 <range> [ both-bases? ] filter sum ;
! [ euler036 ] 100 ave-time
-! 3891 ms run / 173 ms GC ave time - 100 trials
+! 1703 ms ave run time - 96.6 SD (100 trials)
MAIN: euler036
--- /dev/null
+USING: project-euler.037 tools.test ;
+IN: project-euler.037.tests
+
+[ 748317 ] [ euler037 ] unit-test
23 1000000 primes-between [ r-trunc? ] filter [ l-trunc? ] filter sum ;
! [ euler037 ] 100 ave-time
-! 768 ms run / 9 ms GC ave time - 100 trials
+! 130 ms ave run time - 6.27 SD (100 trials)
MAIN: euler037
--- /dev/null
+USING: project-euler.038 tools.test ;
+IN: project-euler.038.tests
+
+[ 932718654 ] [ euler038 ] unit-test
! 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 ;
+USING: kernel math math.parser math.ranges project-euler.common sequences
+ strings ;
IN: project-euler.038
! http://projecteuler.net/index.php?section=problems&id=38
9123 9876 [a,b] [ concat-product ] map [ pandigital? ] filter supremum ;
! [ euler038 ] 100 ave-time
-! 37 ms run / 1 ms GC ave time - 100 trials
+! 11 ms ave run time - 1.5 SD (100 trials)
MAIN: euler038
--- /dev/null
+USING: project-euler.039 tools.test ;
+IN: project-euler.039.tests
+
+[ 840 ] [ euler039 ] unit-test
] with-scope ;
! [ euler039 ] 100 ave-time
-! 2 ms run / 0 ms GC ave time - 100 trials
+! 1 ms ave run time - 0.37 SD (100 trials)
MAIN: euler039
--- /dev/null
+USING: project-euler.040 tools.test ;
+IN: project-euler.040.tests
+
+[ 210 ] [ euler040 ] unit-test
[ swap nth-integer ] with map product ;
! [ euler040 ] 100 ave-time
-! 1002 ms run / 43 ms GC ave time - 100 trials
+! 444 ms ave run time - 23.64 SD (100 trials)
MAIN: euler040
--- /dev/null
+USING: project-euler.041 tools.test ;
+IN: project-euler.041.tests
+
+[ 7652413 ] [ euler041 ] unit-test
[ 10 digits>integer ] map [ prime? ] find nip ;
! [ euler041 ] 100 ave-time
-! 107 ms run / 7 ms GC ave time - 100 trials
+! 64 ms ave run time - 4.22 SD (100 trials)
MAIN: euler041
--- /dev/null
+USING: project-euler.042 tools.test ;
+IN: project-euler.042.tests
+
+[ 162 ] [ euler042 ] unit-test
+[ 162 ] [ euler042a ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: ascii io.files kernel math math.functions namespaces make
- project-euler.common sequences splitting io.encodings.ascii ;
+USING: ascii io.encodings.ascii io.files kernel make math math.functions
+ namespaces project-euler.common sequences splitting ;
IN: project-euler.042
! http://projecteuler.net/index.php?section=problems&id=42
triangle-upto [ member? ] curry count ;
! [ euler042 ] 100 ave-time
-! 27 ms run / 1 ms GC ave time - 100 trials
+! 19 ms ave run time - 1.97 SD (100 trials)
! ALTERNATE SOLUTIONS
source-042 [ alpha-value ] map [ triangle? ] count ;
! [ euler042a ] 100 ave-time
-! 25 ms run / 1 ms GC ave time - 100 trials
+! 21 ms ave run time - 2.2 SD (100 trials)
MAIN: euler042a
--- /dev/null
+USING: project-euler.043 tools.test ;
+IN: project-euler.043.tests
+
+[ 16695334890 ] [ euler043 ] unit-test
+[ 16695334890 ] [ euler043a ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit hashtables kernel math
- math.combinatorics math.parser math.ranges project-euler.common sequences
- sorting sets ;
+USING: combinators.short-circuit kernel math math.combinatorics math.parser
+ math.ranges project-euler.common sequences sets sorting ;
IN: project-euler.043
! http://projecteuler.net/index.php?section=problems&id=43
: interesting? ( seq -- ? )
{
- [ 17 8 pick subseq-divisible? ]
- [ 13 7 pick subseq-divisible? ]
- [ 11 6 pick subseq-divisible? ]
- [ 7 5 pick subseq-divisible? ]
- [ 5 4 pick subseq-divisible? ]
- [ 3 3 pick subseq-divisible? ]
- [ 2 2 pick subseq-divisible? ]
- } 0&& nip ;
+ [ 17 8 rot subseq-divisible? ]
+ [ 13 7 rot subseq-divisible? ]
+ [ 11 6 rot subseq-divisible? ]
+ [ 7 5 rot subseq-divisible? ]
+ [ 5 4 rot subseq-divisible? ]
+ [ 3 3 rot subseq-divisible? ]
+ [ 2 2 rot subseq-divisible? ]
+ } 1&& ;
PRIVATE>
[ interesting? ] filter [ 10 digits>integer ] map sum ;
! [ euler043 ] time
-! 125196 ms run / 19548 ms GC time
+! 104526 ms run / 42735 ms GC time
! ALTERNATE SOLUTIONS
1000 over <range> [ number>digits 3 0 pad-left ] map [ all-unique? ] filter ;
: overlap? ( seq -- ? )
- dup first 2 tail* swap second 2 head = ;
+ [ first 2 tail* ] [ second 2 head ] bi = ;
: clean ( seq -- seq )
[ unclip 1 head prefix concat ] map [ all-unique? ] filter ;
: add-missing-digit ( seq -- seq )
- dup natural-sort 10 swap diff first prefix ;
+ dup natural-sort 10 swap diff prepend ;
: interesting-pandigitals ( -- seq )
17 candidates { 13 11 7 5 3 2 } [
interesting-pandigitals [ 10 digits>integer ] sigma ;
! [ euler043a ] 100 ave-time
-! 19 ms run / 1 ms GC ave time - 100 trials
+! 10 ms ave run time - 1.37 SD (100 trials)
MAIN: euler043a
--- /dev/null
+USING: project-euler.044 tools.test ;
+IN: project-euler.044.tests
+
+[ 5482660 ] [ euler044 ] unit-test
dup 3 * 1- * 2 / ;
: sum-and-diff? ( m n -- ? )
- 2dup + -rot - [ pentagonal? ] bi@ and ;
+ [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ;
PRIVATE>
[ first2 sum-and-diff? ] filter [ first2 - abs ] map infimum ;
! [ euler044 ] 10 ave-time
-! 8924 ms run / 2872 ms GC ave time - 10 trials
+! 4996 ms ave run time - 87.46 SD (10 trials)
! TODO: this solution is ugly and not very efficient...find a better algorithm
--- /dev/null
+USING: project-euler.045 tools.test ;
+IN: project-euler.045.tests
+
+[ 1533776805 ] [ euler045 ] unit-test
143 next-solution ;
! [ euler045 ] 100 ave-time
-! 18 ms run / 1 ms GC ave time - 100 trials
+! 12 ms ave run time - 1.71 SD (100 trials)
MAIN: euler045
--- /dev/null
+USING: project-euler.046 tools.test ;
+IN: project-euler.046.tests
+
+[ 5777 ] [ euler046 ] unit-test
9 disprove-conjecture ;
! [ euler046 ] 100 ave-time
-! 150 ms run / 2 ms GC ave time - 100 trials
+! 37 ms ave run time - 3.39 SD (100 trials)
MAIN: euler046
--- /dev/null
+USING: project-euler.047 tools.test ;
+IN: project-euler.047.tests
+
+[ 134043 ] [ euler047 ] unit-test
+[ 134043 ] [ euler047a ] unit-test
4 646 consecutive ;
! [ euler047 ] time
-! 542708 ms run / 60548 ms GC time
+! 344688 ms run / 20727 ms GC time
! ALTERNATE SOLUTIONS
4 200000 consecutive-under ;
! [ euler047a ] 100 ave-time
-! 503 ms run / 5 ms GC ave time - 100 trials
+! 331 ms ave run time - 19.14 SD (100 trials)
! TODO: I don't like that you have to specify the upper bound, maybe try making
! this lazy so it could also short-circuit when it finds the answer?
--- /dev/null
+USING: project-euler.048 tools.test ;
+IN: project-euler.048.tests
+
+[ 9110846700 ] [ euler048 ] unit-test
--- /dev/null
+USING: project-euler.052 tools.test ;
+IN: project-euler.052.tests
+
+[ 142857 ] [ euler052 ] unit-test
[ number>digits natural-sort ] map all-equal? ;
: candidate? ( n -- ? )
- { [ dup odd? ] [ dup 3 mod zero? ] } 0&& nip ;
+ { [ odd? ] [ 3 mod zero? ] } 1&& ;
: next-all-same ( x n -- n )
dup candidate? [
6 123456 next-all-same ;
! [ euler052 ] 100 ave-time
-! 403 ms run / 7 ms GC ave time - 100 trials
+! 92 ms ave run time - 6.29 SD (100 trials)
MAIN: euler052
--- /dev/null
+USING: project-euler.053 tools.test ;
+IN: project-euler.053.tests
+
+[ 4075 ] [ euler053 ] unit-test
23 100 [a,b] [ dup [ nCk 1000000 > ] with count ] sigma ;
! [ euler053 ] 100 ave-time
-! 64 ms run / 2 ms GC ave time - 100 trials
+! 52 ms ave run time - 4.44 SD (100 trials)
MAIN: euler053
--- /dev/null
+USING: project-euler.055 tools.test ;
+IN: project-euler.055.tests
+
+[ 249 ] [ euler055 ] unit-test
10000 [ lychrel? ] count ;
! [ euler055 ] 100 ave-time
-! 1370 ms run / 31 ms GC ave time - 100 trials
+! 478 ms ave run time - 30.63 SD (100 trials)
MAIN: euler055
--- /dev/null
+USING: project-euler.056 tools.test ;
+IN: project-euler.056.tests
+
+[ 972 ] [ euler056 ] unit-test
[ first2 ^ number>digits sum ] map supremum ;
! [ euler056 ] 100 ave-time
-! 33 ms run / 1 ms GC ave time - 100 trials
+! 22 ms ave run time - 2.13 SD (100 trials)
MAIN: euler056
--- /dev/null
+USING: project-euler.059 tools.test ;
+IN: project-euler.059.tests
+
+[ 107359 ] [ euler059 ] unit-test
source-059 dup 3 crack-key decrypt sum ;
! [ euler059 ] 100 ave-time
-! 13 ms run / 0 ms GC ave time - 100 trials
+! 8 ms ave run time - 1.4 SD (100 trials)
MAIN: euler059
--- /dev/null
+USING: project-euler.067 tools.test ;
+IN: project-euler.067.tests
+
+[ 7273 ] [ euler067 ] unit-test
+[ 7273 ] [ euler067a ] unit-test
source-067 propagate-all first first ;
! [ euler067 ] 100 ave-time
-! 18 ms run / 0 ms GC time
+! 20 ms ave run time - 2.12 SD (100 trials)
! ALTERNATE SOLUTIONS
source-067 max-path ;
! [ euler067a ] 100 ave-time
-! 14 ms run / 0 ms GC ave time - 100 trials
+! 21 ms ave run time - 2.65 SD (100 trials)
MAIN: euler067a
--- /dev/null
+USING: project-euler.075 tools.test ;
+IN: project-euler.075.tests
+
+[ 214954 ] [ euler075 ] unit-test
! 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
+! Given that L is the length of the wire, for how many values of L ≤ 2,000,000
! can exactly one right angle triangle be formed?
! Algorithm adapted from http://mathworld.wolfram.com/PythagoreanTriple.html
! Identical implementation as problem #39
-! Basically, this makes an array of 1000000 zeros, recursively creates
+! Basically, this makes an array of 2000000 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
+! index [a+b+c] by one for each triple's sum AND its multiples under 2000000
! (to account for non-primitive triples). The answer is just the total number
! of indexes that are equal to one.
: euler075 ( -- answer )
[
- 1000000 count-perimeters p-count get [ 1 = ] count
+ 2000000 count-perimeters p-count get [ 1 = ] count
] with-scope ;
-! [ euler075 ] 100 ave-time
-! 1873 ms run / 123 ms GC ave time - 100 trials
+! [ euler075 ] 10 ave-time
+! 3341 ms ave run timen - 157.77 SD (10 trials)
MAIN: euler075
--- /dev/null
+USING: project-euler.076 tools.test ;
+IN: project-euler.076.tests
+
+[ 190569291 ] [ euler076 ] unit-test
! Copyright (c) 2008 Eric Mertens.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs combinators kernel locals math math.order math.ranges
- sequences ;
+USING: arrays assocs kernel locals math math.order math.ranges sequences ;
IN: project-euler.076
! http://projecteuler.net/index.php?section=problems&id=76
100 (euler076) ;
! [ euler076 ] 100 ave-time
-! 704 ms run time - 100 trials
+! 560 ms ave run time - 17.74 SD (100 trials)
MAIN: euler076
--- /dev/null
+USING: project-euler.079 tools.test ;
+IN: project-euler.079.tests
+
+[ 73162890 ] [ euler079 ] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs hashtables io.files kernel math math.parser
-namespaces make io.encodings.ascii sequences sets ;
+USING: assocs io.encodings.ascii io.files kernel make math math.parser
+ sequences sets ;
IN: project-euler.079
! http://projecteuler.net/index.php?section=problems&id=79
source-079 >edges topological-sort 10 digits>integer ;
! [ euler079 ] 100 ave-time
-! 2 ms run / 0 ms GC ave time - 100 trials
+! 1 ms ave run time - 0.46 SD (100 trials)
! TODO: prune and diff are relatively slow; topological sort could be
! cleaned up and generalized much better, but it works for this problem
--- /dev/null
+USING: project-euler.092 tools.test ;
+IN: project-euler.092.tests
+
+[ 8581146 ] [ euler092 ] unit-test
! Copyright (c) 2008 Aaron Schaefer, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.ranges sequences ;
+USING: kernel math math.ranges project-euler.common sequences ;
IN: project-euler.092
! http://projecteuler.net/index.php?section=problems&id=92
<PRIVATE
: next-link ( n -- m )
- 0 swap [ dup zero? not ] [ 10 /mod sq -rot [ + ] dip ] [ ] while drop ;
+ number>digits [ sq ] sigma ;
: chain-ending ( n -- m )
- dup 1 = over 89 = or [ next-link chain-ending ] unless ;
+ dup [ 1 = ] [ 89 = ] bi or [ next-link chain-ending ] unless ;
: lower-endings ( -- seq )
567 [1,b] [ chain-ending ] map ;
: fast-chain-ending ( seq n -- m )
dup 567 > [ next-link ] when 1- swap nth ;
-: count ( seq quot -- n )
- 0 -rot [ rot >r call [ r> 1+ ] [ r> ] if ] curry each ; inline
-
PRIVATE>
: euler092 ( -- answer )
lower-endings 9999999 [1,b] [ fast-chain-ending 89 = ] with count ;
! [ euler092 ] 10 ave-time
-! 11169 ms run / 0 ms GC ave time - 10 trials
+! 33257 ms ave run time - 624.27 SD (10 trials)
+
+! TODO: this solution is not very efficient, much better optimizations exist
MAIN: euler092
--- /dev/null
+USING: project-euler.097 tools.test ;
+IN: project-euler.097.tests
+
+[ 8739992577 ] [ euler097 ] unit-test
2 7830457 10 10 ^ ^mod 28433 * 10 10 ^ mod 1+ ;
! [ euler097 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run timen - 0.22 SD (100 trials)
MAIN: euler097
--- /dev/null
+USING: project-euler.100 tools.test ;
+IN: project-euler.100.tests
+
+[ 756872327473 ] [ euler100 ] unit-test
[ dup dup 1- * 2 * 10 24 ^ <= ]
[ tuck 6 * swap - 2 - ] [ ] while nip ;
-! TODO: solution is incredibly slow (>30 minutes) and needs generalization
+! TODO: solution needs generalization
-! [ euler100 ] time
-! ? ms run time
+! [ euler100 ] 100 ave-time
+! 0 ms ave run time - 0.14 SD (100 trials)
MAIN: euler100
--- /dev/null
+USING: project-euler.116 tools.test ;
+IN: project-euler.116.tests
+
+[ 20492570929 ] [ euler116 ] unit-test
50 (euler116) ;
! [ euler116 ] 100 ave-time
-! 0 ms run time - 100 trials
+! 0 ms ave run time - 0.34 SD (100 trials)
MAIN: euler116
--- /dev/null
+USING: project-euler.117 tools.test ;
+IN: project-euler.117.tests
+
+[ 100808458960497 ] [ euler117 ] unit-test
50 (euler117) ;
! [ euler117 ] 100 ave-time
-! 0 ms run time - 100 trials
+! 0 ms ave run time - 0.29 SD (100 trials)
MAIN: euler117
--- /dev/null
+USING: project-euler.134 tools.test ;
+IN: project-euler.134.tests
+
+[ 18613426663617118 ] [ euler134 ] unit-test
[ [ s + ] keep ] leach drop ;
! [ euler134 ] 10 ave-time
-! 2430 ms run / 36 ms GC ave time - 10 trials
+! 933 ms ave run timen - 19.58 SD (10 trials)
MAIN: euler134
--- /dev/null
+USING: project-euler.148 tools.test ;
+IN: project-euler.148.tests
+
+[ 2129970655314432 ] [ euler148 ] unit-test
10 9 ^ (euler148) ;
! [ euler148 ] 100 ave-time
-! 0 ms run time - 100 trials
+! 0 ms ave run time - 0.17 SD (100 trials)
MAIN: euler148
--- /dev/null
+USING: project-euler.150 tools.test ;
+IN: project-euler.150.tests
+
+[ -271248680 ] [ euler150 ] unit-test
1000 (euler150) ;
! [ euler150 ] 10 ave-time
-! 32858 ms run time - 10 trials
+! 30208 ms ave run time - 593.45 SD (10 trials)
MAIN: euler150
--- /dev/null
+USING: project-euler.164 tools.test ;
+IN: project-euler.164.tests
+
+[ 378158756814587 ] [ euler164 ] unit-test
init-table 19 [ next-table ] times values sum ;
! [ euler164 ] 100 ave-time
-! 8 ms run time - 100 trials
+! 7 ms ave run time - 1.23 SD (100 trials)
MAIN: euler164
--- /dev/null
+USING: project-euler.169 tools.test ;
+IN: project-euler.169.tests
+
+[ 178653872807 ] [ euler169 ] unit-test
! 2 + 4 + 4
! 2 + 8
-! What is f(1025)?
+! What is f(10^25)?
! SOLUTION
10 25 ^ fn ;
! [ euler169 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.2 SD (100 trials)
MAIN: euler169
--- /dev/null
+USING: project-euler.173 tools.test ;
+IN: project-euler.173.tests
+
+[ 1572729 ] [ euler173 ] unit-test
1000000 laminae ;
! [ euler173 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.35 SD (100 trials)
MAIN: euler173
--- /dev/null
+USING: project-euler.175 tools.test ;
+IN: project-euler.175.tests
+
+[ "1,13717420,8" ] [ euler175 ] unit-test
V{ 1 } clone dup 123456789/987654321 compute [ number>string ] map "," join ;
! [ euler175 ] 100 ave-time
-! 0 ms run / 0 ms GC ave time - 100 trials
+! 0 ms ave run time - 0.31 SD (100 trials)
MAIN: euler175
--- /dev/null
+USING: project-euler.186 tools.test ;
+IN: project-euler.186.tests
+
+[ 2325629 ] [ euler186 ] unit-test
-USING: circular disjoint-sets kernel math math.ranges
-sequences ;
+! Copyright (c) 2008 Eric Mertens.
+! See http://factorcode.org/license.txt for BSD license.
+USING: circular disjoint-sets kernel math math.ranges sequences ;
IN: project-euler.186
+! http://projecteuler.net/index.php?section=problems&id=186
+
+! DESCRIPTION
+! -----------
+
+! Here are the records from a busy telephone system with one million users:
+
+! RecNr Caller Called
+! 1 200007 100053
+! 2 600183 500439
+! 3 600863 701497
+! ... ... ...
+
+! The telephone number of the caller and the called number in record n are
+! Caller(n) = S2n-1 and Called(n) = S2n where S1,2,3,... come from the "Lagged
+! Fibonacci Generator":
+
+! For 1 <= k <= 55, Sk = [100003 - 200003k + 300007k^3] (modulo 1000000)
+! For 56 <= k, Sk = [Sk-24 + Sk-55] (modulo 1000000)
+
+! If Caller(n) = Called(n) then the user is assumed to have misdialled and the
+! call fails; otherwise the call is successful.
+
+! From the start of the records, we say that any pair of users X and Y are
+! friends if X calls Y or vice-versa. Similarly, X is a friend of a friend of Z
+! if X is a friend of Y and Y is a friend of Z; and so on for longer chains.
+
+! The Prime Minister's phone number is 524287. After how many successful calls,
+! not counting misdials, will 99% of the users (including the PM) be a friend,
+! or a friend of a friend etc., of the Prime Minister?
+
+
+! SOLUTION
+! --------
+
: (generator) ( k -- n )
dup sq 300007 * 200003 - * 100003 + 1000000 rem ;
[ first ] [ advance ] bi ;
: 2unless? ( x y ?quot quot -- )
- >r 2keep rot [ 2drop ] r> if ; inline
+ [ 2keep rot [ 2drop ] ] dip if ; inline
: (p186) ( generator counter unionfind -- counter )
- 524287 over equiv-set-size 990000 <
- [
+ 524287 over equiv-set-size 990000 < [
pick [ next ] [ next ] bi
[ = ] [
pick equate
: euler186 ( -- n )
<generator> 0 1000000 <relation> (p186) ;
+! [ euler186 ] 10 ave-time
+! 18572 ms ave run time - 796.87 SD (10 trials)
+
MAIN: euler186
--- /dev/null
+USING: project-euler.190 tools.test ;
+IN: project-euler.190.tests
+
+[ 371048281 ] [ euler190 ] unit-test
2 15 [a,b] [ P_m truncate ] sigma ;
! [ euler150 ] 100 ave-time
-! 7 ms run time - 100 trials
+! 5 ms ave run time - 1.01 SD (100 trials)
MAIN: euler190
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: continuations io kernel math math.functions math.parser math.statistics
- namespaces make tools.time ;
+USING: continuations fry io kernel make math math.functions math.parser
+ math.statistics memory tools.time ;
IN: project-euler.ave-time
: collect-benchmarks ( quot n -- seq )
- [
- >r >r datastack r> [ benchmark , ] curry tuck
- [ with-datastack drop ] 2curry r> swap times call
- ] { } make ;
+ [
+ [ datastack ]
+ [ '[ _ gc benchmark , ] tuck '[ _ _ with-datastack drop ] ]
+ [ 1- ] tri* swap times call
+ ] { } make ; inline
: nth-place ( x n -- y )
10 swap ^ [ * round ] keep / ;
: ave-time ( quot n -- )
- [ collect-benchmarks ] keep
- swap [ std 2 nth-place ] [ mean round ] bi [
+ [ collect-benchmarks ] keep swap
+ [ std 2 nth-place ] [ mean round ] bi [
# " ms ave run time - " % # " SD (" % # " trials)" %
] "" make print flush ; inline
-USING: arrays kernel math math.functions math.miller-rabin
-math.matrices math.order math.parser math.primes.factors
-math.ranges namespaces make sequences sequences.lib sorting
-unicode.case ;
+! Copyright (c) 2007-2008 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel make math math.functions math.matrices math.miller-rabin
+ math.order math.parser math.primes.factors math.ranges sequences
+ sequences.lib sorting strings unicode.case ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution
! -------------------------------
! alpha-value - #22, #42
! cartesian-product - #4, #27, #29, #32, #33, #43, #44, #56
-! collect-consecutive - #8, #11
! log10 - #25, #134
! max-path - #18, #67
! nth-triangle - #12, #42
-! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56
+! number>digits - #16, #20, #30, #34, #35, #38, #43, #52, #55, #56, #92
! palindrome? - #4, #36, #55
! pandigital? - #32, #38
! pentagonal? - #44, #45
! [uad]-transform - #39, #75
-: nth-pair ( n seq -- nth next )
- over 1+ over nth >r nth r> ;
+: nth-pair ( seq n -- nth next )
+ tail-slice first2 ;
: perfect-square? ( n -- ? )
dup sqrt mod zero? ;
<PRIVATE
-: count-shifts ( seq width -- n )
- >r length 1+ r> - ;
-
: max-children ( seq -- seq )
- [ dup length 1- [ over nth-pair max , ] each ] { } make nip ;
+ [ dup length 1- [ nth-pair max , ] with each ] { } make ;
! Propagate one row into the upper one
: propagate ( bottom top -- newtop )
[ over rest rot first2 max rot + ] map nip ;
-: shift-3rd ( seq obj obj -- seq obj obj )
- rot rest -rot ;
-
: (sum-divisors) ( n -- sum )
dup sqrt >fixnum [1,b] [
[ 2dup mod zero? [ 2dup / + , ] [ drop ] if ] each
: cartesian-product ( seq1 seq2 -- seq1xseq2 )
swap [ swap [ 2array ] map-with ] map-with concat ;
-: collect-consecutive ( seq width -- seq )
- [
- 2dup count-shifts [ 2dup head shift-3rd , ] times
- ] { } make 2nip ;
-
: log10 ( m -- n )
log 10 log / ;
number>string dup reverse = ;
: pandigital? ( n -- ? )
- number>string natural-sort "123456789" = ;
+ number>string natural-sort >string "123456789" = ;
: pentagonal? ( n -- ? )
dup 0 > [ 24 * 1+ sqrt 1+ 6 / 1 mod zero? ] [ drop f ] if ;
! 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 rest [ propagate dup ] map nip reverse swap suffix ;
+: propagate-all ( triangle -- new-triangle )
+ reverse [ first dup ] [ rest ] bi
+ [ propagate dup ] map nip reverse swap suffix ;
: sum-divisors ( n -- sum )
dup 4 < [ { 0 1 3 4 } nth ] [ (sum-divisors) ] if ;
! Optimized brute-force, is often faster than prime factorization
: tau* ( m -- n )
- factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
- dup sqrt >fixnum [1,b] [
+ factor-2s dup [ 1+ ]
+ [ perfect-square? -1 0 ? ]
+ [ dup sqrt >fixnum [1,b] ] tri* [
dupd mod zero? [ [ 2 + ] dip ] when
] each drop * ;
project-euler.037 project-euler.038 project-euler.039 project-euler.040
project-euler.041 project-euler.042 project-euler.043 project-euler.044
project-euler.045 project-euler.046 project-euler.047 project-euler.048
- project-euler.052 project-euler.053 project-euler.056 project-euler.059
- project-euler.067 project-euler.075 project-euler.079 project-euler.092
- project-euler.097 project-euler.100 project-euler.116 project-euler.117
- project-euler.134 project-euler.148 project-euler.150 project-euler.151
- project-euler.164 project-euler.169 project-euler.173 project-euler.175
- project-euler.186 project-euler.190 ;
+ project-euler.052 project-euler.053 project-euler.055 project-euler.056
+ project-euler.059 project-euler.067 project-euler.075 project-euler.076
+ project-euler.079 project-euler.092 project-euler.097 project-euler.100
+ project-euler.116 project-euler.117 project-euler.134 project-euler.148
+ project-euler.150 project-euler.151 project-euler.164 project-euler.169
+ project-euler.173 project-euler.175 project-euler.186 project-euler.190 ;
IN: project-euler
<PRIVATE
projects / factor.git / commitdiff