diff --git a/basis/math/combinatorics/combinatorics-tests.factor b/basis/math/combinatorics/combinatorics-tests.factor index 8a551bfe9d..6bd75cd3c5 100644 --- a/basis/math/combinatorics/combinatorics-tests.factor +++ b/basis/math/combinatorics/combinatorics-tests.factor @@ -78,7 +78,7 @@ IN: math.combinatorics.tests [ { } ] [ { 1 2 } 0 selections ] unit-test -[ { { 1 2 } } ] [ { 1 2 } 1 selections ] unit-test +[ { { 1 } { 2 } } ] [ { 1 2 } 1 selections ] unit-test [ { { 1 1 } { 1 2 } { 2 1 } { 2 2 } } ] [ { 1 2 } 2 selections ] unit-test diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor index b69867fb12..b1e2864389 100644 --- a/basis/math/combinatorics/combinatorics.factor +++ b/basis/math/combinatorics/combinatorics.factor @@ -1,8 +1,10 @@ ! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer, John Benediktsson. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs binary-search fry kernel locals math math.order - math.ranges namespaces sequences sorting make sequences.deep arrays - combinators ; + +USING: accessors arrays assocs binary-search fry kernel locals +math math.order math.ranges namespaces sequences sequences.deep +sorting ; + IN: math.combinatorics [ -rot ] dip each-combination ; inline : all-subsets ( seq -- subsets ) - dup length [0,b] [ - [ dupd all-combinations [ , ] each ] each - ] { } make nip ; + dup length [0,b] [ all-combinations ] with map concat ; : (selections) ( seq n -- selections ) - dupd [ dup 1 > ] [ - swap pick cartesian-product [ - [ [ dup length 1 > [ flatten ] when , ] each ] each - ] { } make swap 1 - - ] while drop nip ; + [ [ 1array ] map dup ] [ 1 - ] bi* + [ cartesian-product concat ] with times + [ flatten ] map ; : selections ( seq n -- selections ) - { - { 0 [ drop { } ] } - { 1 [ 1array ] } - [ (selections) ] - } case ; + dup 0 > [ (selections) ] [ 2drop { } ] if ; +