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