basis/math/primes/factors/factors.factor

   1 ! Copyright (C) 2007-2009 Samuel Tardieu.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays combinators kernel make math math.functions
   4 math.primes math.ranges sequences sequences.product sorting ;
   5 IN: math.primes.factors
   6
   7 <PRIVATE
   8
   9 : count-factor ( n d -- n' c )
  10     [ 1 ] 2dip [ /i ] keep
  11     [ dupd /mod zero? ] curry [ nip [ 1 + ] dip ] while drop
  12     swap ;
  13
  14 : write-factor ( n d -- n' d' )
  15     2dup divisor? [
  16         [ [ count-factor ] keep swap 2array , ] keep
  17         ! If the remainder is a prime number, increase d so that
  18         ! the caller stops looking for factors.
  19         over prime? [ drop dup ] when
  20     ] when ;
  21
  22 : (group-factors) ( n -- seq )
  23     [
  24         2
  25         [ 2dup sq < ] [ write-factor next-prime ] until
  26         drop dup 2 < [ drop ] [ 1 2array , ] if
  27     ] { } make ;
  28
  29 PRIVATE>
  30
  31 : group-factors ( n -- seq )
  32     dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
  33
  34 : unique-factors ( n -- seq ) group-factors [ first ] map ; flushable
  35
  36 : factors ( n -- seq )
  37     group-factors [ first2 swap <array> ] map concat ; flushable
  38
  39 : totient ( n -- t )
  40     {
  41         { [ dup 2 < ] [ drop 0 ] }
  42         [ dup unique-factors [ 1 [ 1 - * ] reduce ] [ product ] bi / * ]
  43     } cond ; foldable
  44
  45 : divisors ( n -- seq )
  46     group-factors [ first2 [0,b] [ ^ ] with map ] map
  47     [ product ] product-map natural-sort ;