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

Simplify totient in math.primes.factors

db4
Aaron Schaefer 2008-01-14 02:38:23 -05:00
parent 0d166264c8
commit 12b24af934
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,36 +6,36 @@ IN: math.primes.factors
<PRIVATE <PRIVATE
: (factor) ( n d -- n' ) : (factor) ( n d -- n' )
2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ; 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
: (count) ( n d -- n' ) : (count) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
dup empty? [ drop ] [ [ first ] keep length 2array , ] if ; dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
: (unique) ( n d -- n' ) : (unique) ( n d -- n' )
[ (factor) ] { } make [ (factor) ] { } make
dup empty? [ drop ] [ first , ] if ; dup empty? [ drop ] [ first , ] if ;
: (factors) ( quot list n -- ) : (factors) ( quot list n -- )
dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ; dup 1 > [ swap uncons >r pick call r> swap (factors) ] [ 3drop ] if ;
: (decompose) ( n quot -- seq ) : (decompose) ( n quot -- seq )
[ lprimes rot (factors) ] { } make ; [ lprimes rot (factors) ] { } make ;
PRIVATE> PRIVATE>
: factors ( n -- seq ) : factors ( n -- seq )
[ (factor) ] (decompose) ; foldable [ (factor) ] (decompose) ; foldable
: count-factors ( n -- seq ) : count-factors ( n -- seq )
[ (count) ] (decompose) ; foldable [ (count) ] (decompose) ; foldable
: unique-factors ( n -- seq ) : unique-factors ( n -- seq )
[ (unique) ] (decompose) ; foldable [ (unique) ] (decompose) ; foldable
: totient ( n -- t ) : totient ( n -- t )
dup 2 < [ dup 2 < [
drop 0 drop 0
] [ ] [
[ unique-factors dup 1 [ 1- * ] reduce swap product / ] keep * dup unique-factors dup 1 [ 1- * ] reduce swap product / *
] if ; foldable ] if ; foldable