1 ! Copyright (C) 2007 Samuel Tardieu.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays kernel lists math math.primes namespaces make
5 IN: math.primes.factors
9 : (factor) ( n d -- n' )
10 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
12 : (count) ( n d -- n' )
14 [ [ first ] keep length 2array , ] unless-empty ;
16 : (unique) ( n d -- n' )
18 [ first , ] unless-empty ;
20 : (factors) ( quot list n -- )
21 dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ;
23 : (decompose) ( n quot -- seq )
24 [ lprimes rot (factors) ] { } make ;
28 : factors ( n -- seq )
29 [ (factor) ] (decompose) ; foldable
31 : group-factors ( n -- seq )
32 [ (count) ] (decompose) ; foldable
34 : unique-factors ( n -- seq )
35 [ (unique) ] (decompose) ; foldable
41 dup unique-factors dup 1 [ 1- * ] reduce swap product / *