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

math.primes.erato.fast: some bignum fixes and more tests.

db4
John Benediktsson 2015-06-16 08:20:32 -07:00
parent e3ec051527
commit 7e23c12c0f
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/math/primes/erato/fast/fast-tests.factor
View File

@ -1,4 +1,4 @@
USING: sequences tools.test ; USING: fry kernel sequences tools.test ;
IN: math.primes.erato.fast IN: math.primes.erato.fast
{ {
@ -12,3 +12,10 @@ IN: math.primes.erato.fast
{ 1229 } [ 10,000 sieve length ] unit-test { 1229 } [ 10,000 sieve length ] unit-test
{ 9592 } [ 100,000 sieve length ] unit-test { 9592 } [ 100,000 sieve length ] unit-test
{ 78498 } [ 1,000,000 sieve length ] unit-test { 78498 } [ 1,000,000 sieve length ] unit-test
{ t } [
{ 2 3 5 7 11 13 } 100 make-sieve '[ _ marked-prime? ] all?
] unit-test
{ t } [
{ 4 6 8 9 10 12 } 100 make-sieve '[ _ marked-prime? not ] all?
] unit-test

11
basis/math/primes/erato/fast/fast.factor
View File

@ -14,7 +14,7 @@ CONSTANT: wheel-2-3-5-7 B{
} }
:: each-prime ( upto sieve quot -- ) :: each-prime ( upto sieve quot -- )
11 upto >fixnum '[ dup _ <= ] [ 11 upto integer>fixnum-strict '[ dup _ <= ] [
wheel-2-3-5-7 [ wheel-2-3-5-7 [
over dup 2/ sieve nth-unsafe [ drop ] quot if over dup 2/ sieve nth-unsafe [ drop ] quot if
fixnum+fast fixnum+fast
@ -23,7 +23,7 @@ CONSTANT: wheel-2-3-5-7 B{
:: mark-multiples ( i upto sieve -- ) :: mark-multiples ( i upto sieve -- )
i 2 fixnum*fast :> step i 2 fixnum*fast :> step
i i fixnum*fast upto >fixnum '[ dup _ <= ] [ i i fixnum*fast upto integer>fixnum-strict '[ dup _ <= ] [
t over 2/ sieve set-nth-unsafe t over 2/ sieve set-nth-unsafe
step fixnum+fast step fixnum+fast
] while drop ; inline ] while drop ; inline
@ -37,7 +37,8 @@ PRIVATE>
n sieve-bits <bit-array> :> sieve n sieve-bits <bit-array> :> sieve
t 0 sieve set-nth t 0 sieve set-nth
t 4 sieve set-nth t 4 sieve set-nth
n sqrt sieve [ n sieve mark-multiples ] each-prime n sqrt >integer sieve
[ n sieve mark-multiples ] each-prime
sieve ; inline sieve ; inline
:: sieve ( n -- primes ) :: sieve ( n -- primes )
@ -46,5 +47,5 @@ PRIVATE>
dup n <= [ primes push ] [ drop ] if dup n <= [ primes push ] [ drop ] if
] each-prime primes ; ] each-prime primes ;
:: sieve-prime? ( i sieve -- prime? ) :: marked-prime? ( i sieve -- prime? )
i even? [ f ] [ i 2/ sieve nth ] if ; i dup even? [ 2 = ] [ 2/ sieve nth not ] if ;