From 78fbeda1056858d9dd1e6b872bf5de051246be02 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Wed, 7 Jan 2009 09:58:46 +0100
Subject: [PATCH] Refactor prime factors decomposition module and add more
tests
---
.../math/primes/factors/factors-tests.factor | 2 ++
extra/math/primes/factors/factors.factor | 29 +++++++++----------
2 files changed, 15 insertions(+), 16 deletions(-)
diff --git a/extra/math/primes/factors/factors-tests.factor b/extra/math/primes/factors/factors-tests.factor
index 70b905f4ab..f247683c1c 100644
--- a/extra/math/primes/factors/factors-tests.factor
+++ b/extra/math/primes/factors/factors-tests.factor
@@ -1,6 +1,8 @@
USING: math.primes.factors tools.test ;
{ { 999983 999983 1000003 } } [ 999969000187000867 factors ] unit-test
+{ { } } [ -5 factors ] unit-test
{ { { 999983 2 } { 1000003 1 } } } [ 999969000187000867 group-factors ] unit-test
{ { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
{ 999967000236000612 } [ 999969000187000867 totient ] unit-test
+{ 0 } [ 1 totient ] unit-test
diff --git a/extra/math/primes/factors/factors.factor b/extra/math/primes/factors/factors.factor
index 80c93f2ae0..282c46c82e 100644
--- a/extra/math/primes/factors/factors.factor
+++ b/extra/math/primes/factors/factors.factor
@@ -1,39 +1,36 @@
-! Copyright (C) 2007 Samuel Tardieu.
+! Copyright (C) 2007-2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel lists make math math.primes sequences ;
IN: math.primes.factors
<PRIVATE
-: (factor) ( n d -- n' )
- 2dup mod zero? [ [ / ] keep dup , (factor) ] [ drop ] if ;
+: count-factor ( n d -- n' c )
+ 0 [ [ 2dup mod zero? ] dip swap ] [ [ [ / ] keep ] dip 1+ ] [ ] while nip ;
+
+: (factor) ( n d -- n' ) dup [ , ] curry [ count-factor ] dip times ;
: (count) ( n d -- n' )
- [ (factor) ] { } make
- [ [ first ] [ length ] bi 2array , ] unless-empty ;
+ dup [ swap 2array , ] curry
+ [ count-factor dup zero? [ drop ] ] dip if ;
: (unique) ( n d -- n' )
- [ (factor) ] { } make
- [ first , ] unless-empty ;
+ dup [ , ] curry [ count-factor zero? ] dip unless ;
: (factors) ( quot list n -- )
dup 1 > [
swap uncons swap [ pick call ] dip swap (factors)
- ] [ 3drop ] if ;
+ ] [ 3drop ] if ; inline recursive
-: (decompose) ( n quot -- seq )
- [ lprimes rot (factors) ] { } make ;
+: decompose ( n quot -- seq ) [ lprimes rot (factors) ] { } make ; inline
PRIVATE>
-: factors ( n -- seq )
- [ (factor) ] (decompose) ; foldable
+: factors ( n -- seq ) [ (factor) ] decompose ; flushable
-: group-factors ( n -- seq )
- [ (count) ] (decompose) ; foldable
+: group-factors ( n -- seq ) [ (count) ] decompose ; flushable
-: unique-factors ( n -- seq )
- [ (unique) ] (decompose) ; foldable
+: unique-factors ( n -- seq ) [ (unique) ] decompose ; flushable
: totient ( n -- t )
dup 2 < [