steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up Project Euler solutions

db4
Aaron Schaefer 2008-10-30 22:04:44 -04:00
parent 89db7676c4
commit f2538d0156
12 changed files with 46 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/project-euler/006/006.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.006
! http://projecteuler.net/index.php?section=problems&id=6 ! http://projecteuler.net/index.php?section=problems&id=6
@ -35,9 +35,9 @@ IN: project-euler.006
PRIVATE> PRIVATE>
: euler006 ( -- answer ) : 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 ! [ 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 MAIN: euler006

14
extra/project-euler/009/009.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.009
! http://projecteuler.net/index.php?section=problems&id=9 ! http://projecteuler.net/index.php?section=problems&id=9
@ -31,13 +31,13 @@ IN: project-euler.009
: abc ( p q -- triplet ) : abc ( p q -- triplet )
[ [
2dup * , ! a = p * q 2dup * , ! a = p * q
[ sq ] bi@ 2dup - 2 / , ! b = (p² - q²) / 2 [ sq ] bi@
+ 2 / , ! c = (p² + q²) / 2 [ - 2 / , ] ! b = (p² - q²) / 2
[ + 2 / , ] 2bi ! c = (p² + q²) / 2
] { } make natural-sort ; ] { } make natural-sort ;
: (ptriplet) ( target p q triplet -- target p q ) : (ptriplet) ( target p q triplet -- target p q )
roll [ swap sum = ] keep -roll sum [ pick ] dip = [ next-pq 2dup abc (ptriplet) ] unless ;
[ next-pq 2dup abc (ptriplet) ] unless ;
: ptriplet ( target -- triplet ) : ptriplet ( target -- triplet )
3 1 { 3 4 5 } (ptriplet) abc nip ; 3 1 { 3 4 5 } (ptriplet) abc nip ;
@ -48,6 +48,6 @@ PRIVATE>
1000 ptriplet product ; 1000 ptriplet product ;
! [ euler009 ] 100 ave-time ! [ 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 MAIN: euler009

3
extra/project-euler/014/014.factor
View File

@ -1,7 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators.short-circuit kernel USING: combinators.short-circuit kernel make math math.ranges sequences ;
math math.ranges namespaces make sequences sorting ;
IN: project-euler.014 IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14 ! http://projecteuler.net/index.php?section=problems&id=14

6
extra/project-euler/016/016.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.016
! http://projecteuler.net/index.php?section=problems&id=16 ! http://projecteuler.net/index.php?section=problems&id=16
@ -20,6 +20,6 @@ IN: project-euler.016
2 1000 ^ number>digits sum ; 2 1000 ^ number>digits sum ;
! [ euler016 ] 100 ave-time ! [ 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 MAIN: euler016

9
extra/project-euler/017/017.factor
View File

@ -1,7 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.ranges math.text.english sequences strings USING: ascii kernel math.ranges math.text.english sequences ;
ascii combinators.short-circuit ;
IN: project-euler.017 IN: project-euler.017
! http://projecteuler.net/index.php?section=problems&id=17 ! http://projecteuler.net/index.php?section=problems&id=17
@ -26,7 +25,7 @@ IN: project-euler.017
: euler017 ( -- answer ) : euler017 ( -- answer )
1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ; 1000 [1,b] SBUF" " clone [ number>text over push-all ] reduce [ Letter? ] count ;
! [ euler017a ] 100 ave-time ! [ euler017 ] 100 ave-time
! 14 ms run / 0 ms GC ave time - 100 trials ! 15 ms ave run time - 1.71 SD (100 trials)
MAIN: euler017 MAIN: euler017

6
extra/project-euler/020/020.factor
View File

@ -1,6 +1,6 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007-2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! 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 IN: project-euler.020
! http://projecteuler.net/index.php?section=problems&id=20 ! http://projecteuler.net/index.php?section=problems&id=20
@ -20,6 +20,6 @@ IN: project-euler.020
100 factorial number>digits sum ; 100 factorial number>digits sum ;
! [ euler020 ] 100 ave-time ! [ 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 MAIN: euler020

3
extra/project-euler/023/023.factor
View File

@ -1,7 +1,6 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables kernel math math.ranges project-euler.common sequences USING: kernel math math.ranges project-euler.common sequences sets sorting ;
sorting sets ;
IN: project-euler.023 IN: project-euler.023
! http://projecteuler.net/index.php?section=problems&id=23 ! http://projecteuler.net/index.php?section=problems&id=23

4
extra/project-euler/025/025.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel math math.constants math.functions math.parser USING: kernel math math.constants math.functions math.parser memoize
math.ranges memoize project-euler.common sequences ; project-euler.common sequences ;
IN: project-euler.025 IN: project-euler.025
! http://projecteuler.net/index.php?section=problems&id=25 ! http://projecteuler.net/index.php?section=problems&id=25

4
extra/project-euler/028/028.factor
View File

@ -30,7 +30,7 @@ IN: project-euler.028
<PRIVATE <PRIVATE
: sum-corners ( n -- sum ) : sum-corners ( n -- sum )
dup 1 = [ [ sq 4 * ] keep 6 * - 6 + ] unless ; dup 1 = [ [ sq 4 * ] [ 6 * ] bi - 6 + ] unless ;
: sum-diags ( n -- sum ) : sum-diags ( n -- sum )
1 swap 2 <range> [ sum-corners ] sigma ; 1 swap 2 <range> [ sum-corners ] sigma ;
@ -41,6 +41,6 @@ PRIVATE>
1001 sum-diags ; 1001 sum-diags ;
! [ euler028 ] 100 ave-time ! [ 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 MAIN: euler028

16
extra/project-euler/031/031.factor
View File

@ -30,25 +30,25 @@ IN: project-euler.031
drop 1 ; drop 1 ;
: 2p ( m -- n ) : 2p ( m -- n )
dup 0 >= [ [ 2 - 2p ] keep 1p + ] [ drop 0 ] if ; dup 0 >= [ [ 2 - 2p ] [ 1p ] bi + ] [ drop 0 ] if ;
: 5p ( m -- n ) : 5p ( m -- n )
dup 0 >= [ [ 5 - 5p ] keep 2p + ] [ drop 0 ] if ; dup 0 >= [ [ 5 - 5p ] [ 2p ] bi + ] [ drop 0 ] if ;
: 10p ( m -- n ) : 10p ( m -- n )
dup 0 >= [ [ 10 - 10p ] keep 5p + ] [ drop 0 ] if ; dup 0 >= [ [ 10 - 10p ] [ 5p ] bi + ] [ drop 0 ] if ;
: 20p ( m -- n ) : 20p ( m -- n )
dup 0 >= [ [ 20 - 20p ] keep 10p + ] [ drop 0 ] if ; dup 0 >= [ [ 20 - 20p ] [ 10p ] bi + ] [ drop 0 ] if ;
: 50p ( m -- n ) : 50p ( m -- n )
dup 0 >= [ [ 50 - 50p ] keep 20p + ] [ drop 0 ] if ; dup 0 >= [ [ 50 - 50p ] [ 20p ] bi + ] [ drop 0 ] if ;
: 100p ( m -- n ) : 100p ( m -- n )
dup 0 >= [ [ 100 - 100p ] keep 50p + ] [ drop 0 ] if ; dup 0 >= [ [ 100 - 100p ] [ 50p ] bi + ] [ drop 0 ] if ;
: 200p ( m -- n ) : 200p ( m -- n )
dup 0 >= [ [ 200 - 200p ] keep 100p + ] [ drop 0 ] if ; dup 0 >= [ [ 200 - 200p ] [ 100p ] bi + ] [ drop 0 ] if ;
PRIVATE> PRIVATE>
@ -56,7 +56,7 @@ PRIVATE>
200 200p ; 200 200p ;
! [ euler031 ] 100 ave-time ! [ 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? ! TODO: generalize to eliminate duplication; use a sequence to specify denominations?

6
extra/project-euler/032/032.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: hashtables kernel math math.combinatorics math.functions USING: kernel math math.combinatorics math.functions math.parser math.ranges
math.parser math.ranges project-euler.common sequences sets ; project-euler.common sequences sets ;
IN: project-euler.032 IN: project-euler.032
! http://projecteuler.net/index.php?section=problems&id=32 ! http://projecteuler.net/index.php?section=problems&id=32
@ -38,7 +38,7 @@ IN: project-euler.032
[ string>number ] tri@ [ * ] dip = ; [ string>number ] tri@ [ * ] dip = ;
: valid? ( n -- ? ) : valid? ( n -- ? )
dup 1and4 swap 2and3 or ; [ 1and4 ] [ 2and3 ] bi or ;
: products ( seq -- m ) : products ( seq -- m )
[ 10 4 ^ mod ] map ; [ 10 4 ^ mod ] map ;

13
extra/project-euler/common/common.factor
View File

@ -1,7 +1,8 @@
USING: arrays kernel math math.functions math.miller-rabin ! Copyright (c) 2007-2008 Aaron Schaefer.
math.matrices math.order math.parser math.primes.factors ! See http://factorcode.org/license.txt for BSD license.
math.ranges namespaces make sequences sequences.lib sorting USING: arrays kernel math math.functions math.miller-rabin math.matrices
unicode.case ; math.order math.parser math.primes.factors math.ranges make namespaces
sequences sequences.lib sorting unicode.case ;
IN: project-euler.common 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
@ -26,7 +27,7 @@ IN: project-euler.common
: nth-pair ( n seq -- nth next ) : nth-pair ( n seq -- nth next )
over 1+ over nth >r nth r> ; 2dup [ 1+ ] dip [ nth ] 2bi@ ;
: perfect-square? ( n -- ? ) : perfect-square? ( n -- ? )
dup sqrt mod zero? ; dup sqrt mod zero? ;
@ -34,7 +35,7 @@ IN: project-euler.common
<PRIVATE <PRIVATE
: count-shifts ( seq width -- n ) : count-shifts ( seq width -- n )
>r length 1+ r> - ; [ length 1+ ] dip - ;
: max-children ( seq -- seq ) : max-children ( seq -- seq )
[ dup length 1- [ over nth-pair max , ] each ] { } make nip ; [ dup length 1- [ over nth-pair max , ] each ] { } make nip ;