extra/math/primes/factors/factors.factor

   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 sequences ;
   4 IN: math.primes.factors
   5
   6 <PRIVATE
   7
   8 : (factor) ( n d -- n' )
   9     2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
  10
  11 : (count) ( n d -- n' )
  12     [ (factor) ] { } make
  13     [ [ first ] keep length 2array , ] unless-empty ;
  14
  15 : (unique) ( n d -- n' )
  16     [ (factor) ] { } make
  17     [ first , ] unless-empty ;
  18
  19 : (factors) ( quot list n -- )
  20     dup 1 > [ swap uncons swap >r pick call r> swap (factors) ] [ 3drop ] if ;
  21
  22 : (decompose) ( n quot -- seq )
  23     [ lprimes rot (factors) ] { } make ;
  24
  25 PRIVATE>
  26
  27 : factors ( n -- seq )
  28     [ (factor) ] (decompose) ; foldable
  29
  30 : group-factors ( n -- seq )
  31     [ (count) ] (decompose) ; foldable
  32
  33 : unique-factors ( n -- seq )
  34     [ (unique) ] (decompose) ; foldable
  35
  36 : totient ( n -- t )
  37     dup 2 < [
  38         drop 0
  39     ] [
  40         dup unique-factors dup 1 [ 1- * ] reduce swap product / *
  41     ] if ; foldable