When a factor has been found, check if the remainder is a prime number

Performances are greatly increased when a large prime number is involved.
Also, mark some words as flushable, even if it is unlikely that they
will be invoked if their result is discarded.

diff --git a/basis/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor
index 983de512169c40b244ba9a057c68bacbfdc40d7e..8e2e10711a3766e80034f9e895b2c061b12acab8 100644 (file)
--- a/basis/math/primes/factors/factors-tests.factor
+++ b/basis/math/primes/factors/factors-tests.factor
@@ -7,3 +7,4 @@ USING: math.primes.factors tools.test ;
 { 999967000236000612 } [ 999969000187000867 totient ] unit-test
 { 0 } [ 1 totient ] unit-test
 { { 425612003 } } [ 425612003 factors ] unit-test
+{ { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test

diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor
index beab0ac5a664c9aa40a63e9889768cc1afb996f9..199b72b7e146143f510a6752b4e8488db830b820 100644 (file)
--- a/basis/math/primes/factors/factors.factor
+++ b/basis/math/primes/factors/factors.factor
@@ -10,21 +10,30 @@ IN: math.primes.factors
     [ dupd /mod zero? ] curry [ nip [ 1+ ] dip ] while drop
     swap ;
 
-: write-factor ( n d -- n' d )
-    2dup mod zero? [ [ [ count-factor ] keep swap 2array , ] keep ] when ;
-
-PRIVATE>
-
-: group-factors ( n -- seq )
+: write-factor ( n d -- n' d' )
+    2dup mod zero? [
+        [ [ 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 ;
 
-: unique-factors ( n -- seq ) group-factors [ first ] map ;
+PRIVATE>
+
+: group-factors ( n -- seq )
+    dup prime? [ 1 2array 1array ] [ (group-factors) ] if ; flushable
+
+: unique-factors ( n -- seq ) group-factors [ first ] map ; flushable
 
-: factors ( n -- seq ) group-factors [ first2 swap <array> ] map concat ;
+: factors ( n -- seq )
+    group-factors [ first2 swap <array> ] map concat ; flushable
 
 : totient ( n -- t )
     {