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

When a factor has been found, check if the remainder is a prime number 

Performances are greatly increased when a large prime number is involved.
Also, mark some words as flushable, even if it is unlikely that they
will be invoked if their result is discarded.
db4
Samuel Tardieu 2009-03-02 18:59:36 +01:00
parent 5aba91a0c5
commit b5e08a8e3e
2 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/math/primes/factors/factors-tests.factor
View File

@ -7,3 +7,4 @@ USING: math.primes.factors tools.test ;
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test { 999967000236000612 } [ 999969000187000867 totient ] unit-test
{ 0 } [ 1 totient ] unit-test { 0 } [ 1 totient ] unit-test
{ { 425612003 } } [ 425612003 factors ] unit-test { { 425612003 } } [ 425612003 factors ] unit-test
{ { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test

23
basis/math/primes/factors/factors.factor
View File

@ -10,21 +10,30 @@ IN: math.primes.factors
[ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop
swap ; swap ;
: write-factor ( n d -- n' d ) : write-factor ( n d -- n' d' )
2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ; 2dup mod zero? [
[ [ count-factor ] keep swap 2array , ] keep
! If the remainder is a prime number, increase d so that
! the caller stops looking for factors.
over prime? [ drop dup ] when
] when ;
PRIVATE> : (group-factors) ( n -- seq )
: group-factors ( n -- seq )
[ [
2 2
[ 2dup sq < ] [ write-factor next-prime ] until [ 2dup sq < ] [ write-factor next-prime ] until
drop dup 2 < [ drop ] [ 1 2array , ] if drop dup 2 < [ drop ] [ 1 2array , ] if
] { } make ; ] { } make ;
: unique-factors ( n -- seq ) group-factors [ first ] map ; PRIVATE>
: factors ( n -- seq ) group-factors [ first2 swap <array> ] map concat ; : group-factors ( n -- seq )
dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
: unique-factors ( n -- seq ) group-factors [ first ] map ; flushable
: factors ( n -- seq )
group-factors [ first2 swap <array> ] map concat ; flushable
: totient ( n -- t ) : totient ( n -- t )
{ {