Simplify totient in math.primes.factors
parent
0d166264c8
commit
12b24af934
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue