math.combinatorics: Fixing selections bug with nested sequences.

db4
John Benediktsson 2010-08-13 14:34:14 -07:00
parent c3045005ef
commit ae17190909
2 changed files with 9 additions and 5 deletions

View File

@ -79,6 +79,7 @@ IN: math.combinatorics.tests
[ { } ] [ { 1 2 } 0 selections ] unit-test [ { } ] [ { 1 2 } 0 selections ] unit-test
[ { { 1 } { 2 } } ] [ { 1 2 } 1 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 1 } { 1 2 } { 2 1 } { 2 2 } } ]
[ { 1 2 } 2 selections ] unit-test [ { 1 2 } 2 selections ] unit-test

View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs binary-search fry kernel locals USING: accessors arrays assocs binary-search fry kernel locals
math math.order math.ranges namespaces sequences sequences.deep math math.order math.ranges namespaces sequences sorting ;
sorting ;
IN: math.combinatorics IN: math.combinatorics
@ -133,10 +132,14 @@ PRIVATE>
: all-subsets ( seq -- subsets ) : all-subsets ( seq -- subsets )
dup length [0,b] [ all-combinations ] with map concat ; dup length [0,b] [ all-combinations ] with map concat ;
<PRIVATE
: (selections) ( seq n -- selections ) : (selections) ( seq n -- selections )
[ [ 1array ] map dup ] [ 1 - ] bi* [ [ 1array ] map dup ] [ 1 - ] bi* [
[ cartesian-product concat ] with times cartesian-product concat [ { } concat-as ] map
[ flatten ] map ; ] with times ;
PRIVATE>
: selections ( seq n -- selections ) : selections ( seq n -- selections )
dup 0 > [ (selections) ] [ 2drop { } ] if ; dup 0 > [ (selections) ] [ 2drop { } ] if ;