]> gitweb.factorcode.org Git - factor.git/commitdiff
math.primes.factors: fully switch over to new hotness.
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 29 Dec 2021 20:11:39 +0000 (12:11 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 29 Dec 2021 20:11:39 +0000 (12:11 -0800)
basis/math/primes/factors/factors.factor

index aff87c5317da993f1c300dad8095ef21078ab5ac..715d886441cdddfd67fa1f254c8c87f8647e1769 100644 (file)
@@ -1,41 +1,16 @@
 ! Copyright (C) 2007-2009 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs combinators command-line io kernel make
-math math.functions math.parser math.primes
-math.primes.pollard-rho-brent math.ranges namespaces sequences
-sequences.product sorting splitting ;
+USING: arrays combinators command-line io kernel math
+math.functions math.parser math.primes.pollard-rho-brent
+math.ranges math.statistics namespaces sequences
+sequences.product sets sorting splitting ;
 IN: math.primes.factors
 
-<PRIVATE
-
-: count-factor ( n d -- n' c )
-    [ 1 ] 2dip [ /i ] keep
-    [ dupd /mod zero? ] curry [ nip [ 1 + ] dip ] while drop
-    swap ;
-
-: write-factor ( n d -- n' d' )
-    2dup divisor? [
-        [ [ count-factor ] keep swap 2array , ] keep
-        ! If the remainder is a prime number, increase d so that
-        ! the caller stops looking for factors.
-        over prime? [ drop dup ] when
-    ] when ;
-
-: (group-factors) ( n -- seq )
-    [
-        2
-        [ 2dup sq < ] [ write-factor next-prime ] until
-        drop dup 2 < [ drop ] [ 1 2array , ] if
-    ] { } make ;
-
-PRIVATE>
-
-: group-factors ( n -- seq )
-    dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
+: factors ( n -- seq ) pollard-rho-brent-factors ; flushable
 
-: unique-factors ( n -- seq ) group-factors keys ; flushable
+: group-factors ( n -- seq ) factors histogram sort-keys ; flushable
 
-: factors ( n -- seq ) pollard-rho-brent-factors ; flushable
+: unique-factors ( n -- seq ) factors members ; flushable
 
 : totient ( n -- t )
     {