1 ! Copyright (C) 2007 Samuel Tardieu.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays kernel lists lists.lazy math math.primes namespaces sequences ;
4 IN: math.primes.factors
8 : (factor) ( n d -- n' )
9 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
11 : (count) ( n d -- n' )
13 dup empty? [ drop ] [ [ first ] keep length 2array , ] if ;
15 : (unique) ( n d -- n' )
17 dup empty? [ drop ] [ first , ] if ;
19 : (factors) ( quot list n -- )
20 dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ;
22 : (decompose) ( n quot -- seq )
23 [ lprimes rot (factors) ] { } make ;
27 : factors ( n -- seq )
28 [ (factor) ] (decompose) ; foldable
30 : group-factors ( n -- seq )
31 [ (count) ] (decompose) ; foldable
33 : unique-factors ( n -- seq )
34 [ (unique) ] (decompose) ; foldable
40 dup unique-factors dup 1 [ 1- * ] reduce swap product / *