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 < [