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

Refactor prime factors decomposition module and add more tests

db4
Samuel Tardieu 2009-01-07 09:58:46 +01:00
parent 67c37de79c
commit 78fbeda105
2 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/math/primes/factors/factors-tests.factor
View File

@ -1,6 +1,8 @@
USING: math.primes.factors tools.test ; USING: math.primes.factors tools.test ;
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test { { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
{ { } } [ -5 factors ] unit-test
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test { { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test { { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test { 999967000236000612 } [ 999969000187000867 totient ] unit-test
{ 0 } [ 1 totient ] unit-test

29
extra/math/primes/factors/factors.factor
View File

@ -1,39 +1,36 @@
! Copyright (C) 2007 Samuel Tardieu. ! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel lists make math math.primes sequences ; USING: arrays kernel lists make math math.primes sequences ;
IN: math.primes.factors IN: math.primes.factors
<PRIVATE <PRIVATE
: (factor) ( n d -- n' ) : count-factor ( n d -- n' c )
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ; 0 [ [ 2dup mod zero? ] dip swap ] [ [ [ / ] keep ] dip 1+ ] [ ] while nip ;
: (factor) ( n d -- n' ) dup [ , ] curry [ count-factor ] dip times ;
: (count) ( n d -- n' ) : (count) ( n d -- n' )
[ (factor) ] { } make dup [ swap 2array , ] curry
[ [ first ] [ length ] bi 2array , ] unless-empty ; [ count-factor dup zero? [ drop ] ] dip if ;
: (unique) ( n d -- n' ) : (unique) ( n d -- n' )
[ (factor) ] { } make dup [ , ] curry [ count-factor zero? ] dip unless ;
[ first , ] unless-empty ;
: (factors) ( quot list n -- ) : (factors) ( quot list n -- )
dup 1 > [ dup 1 > [
swap uncons swap [ pick call ] dip swap (factors) swap uncons swap [ pick call ] dip swap (factors)
] [ 3drop ] if ; ] [ 3drop ] if ; inline recursive
: (decompose) ( n quot -- seq ) : decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline
[ lprimes rot (factors) ] { } make ;
PRIVATE> PRIVATE>
: factors ( n -- seq ) : factors ( n -- seq ) [ (factor) ] decompose ; flushable
[ (factor) ] (decompose) ; foldable
: group-factors ( n -- seq ) : group-factors ( n -- seq ) [ (count) ] decompose ; flushable
[ (count) ] (decompose) ; foldable
: unique-factors ( n -- seq ) : unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable
[ (unique) ] (decompose) ; foldable
: totient ( n -- t ) : totient ( n -- t )
dup 2 < [ dup 2 < [