math.combinatorics: all-subsets and selections words (contributed by John Benediktsson)
parent
73833ebb18
commit
37bddfba54
|
@ -103,3 +103,29 @@ HELP: >permutation
|
|||
{ $notes "For clarification, the following two statements are equivalent:" { $code "10 factoradic >permutation" "{ 1 2 0 0 } >permutation" } }
|
||||
{ $examples { $example "USING: math.combinatorics.private prettyprint ;" "{ 0 0 0 0 } >permutation ." "{ 0 1 2 3 }" } } ;
|
||||
|
||||
HELP: all-subsets
|
||||
{ $values { "seq" sequence } { "subsets" sequence } }
|
||||
{ $description
|
||||
"Returns all the subsets of a sequence."
|
||||
}
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: math.combinatorics prettyprint ;"
|
||||
"{ 1 2 3 } all-subsets ."
|
||||
"{ { } { 1 } { 2 } { 3 } { 1 2 } { 1 3 } { 2 3 } { 1 2 3 } }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: selections
|
||||
{ $values { "seq" sequence } { "n" integer } { "selections" sequence } }
|
||||
{ $description
|
||||
"Returns all the ways to take n (possibly the same) items from the "
|
||||
"sequence of items."
|
||||
}
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: math.combinatorics prettyprint ;"
|
||||
"{ 1 2 } 2 selections ."
|
||||
"{ { 1 1 } { 1 2 } { 2 1 } { 2 2 } }"
|
||||
}
|
||||
} ;
|
||||
|
|
|
@ -70,3 +70,20 @@ IN: math.combinatorics.tests
|
|||
[ { { "a" "b" } { "a" "c" }
|
||||
{ "a" "d" } { "b" "c" }
|
||||
{ "b" "d" } { "c" "d" } } ] [ { "a" "b" "c" "d" } 2 all-combinations ] unit-test
|
||||
|
||||
[ { { } } ] [ { } all-subsets ] unit-test
|
||||
|
||||
[ { { } { 1 } { 2 } { 3 } { 1 2 } { 1 3 } { 2 3 } { 1 2 3 } } ]
|
||||
[ { 1 2 3 } all-subsets ] unit-test
|
||||
|
||||
[ { } ] [ { 1 2 } 0 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
|
||||
|
||||
[ { { 1 1 1 } { 1 1 2 } { 1 2 1 } { 1 2 2 }
|
||||
{ 2 1 1 } { 2 1 2 } { 2 2 1 } { 2 2 2 } } ]
|
||||
[ { 1 2 } 3 selections ] unit-test
|
||||
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer.
|
||||
! 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 ;
|
||||
math.ranges namespaces sequences sorting make sequences.deep arrays
|
||||
combinators ;
|
||||
IN: math.combinatorics
|
||||
|
||||
<PRIVATE
|
||||
|
@ -126,3 +127,23 @@ PRIVATE>
|
|||
|
||||
: reduce-combinations ( seq k identity quot -- result )
|
||||
[ -rot ] dip each-combination ; inline
|
||||
|
||||
: all-subsets ( seq -- subsets )
|
||||
dup length [0,b] [
|
||||
[ dupd all-combinations [ , ] each ] each
|
||||
] { } make nip ;
|
||||
|
||||
: (selections) ( seq n -- selections )
|
||||
dupd [ dup 1 > ] [
|
||||
swap pick cartesian-product [
|
||||
[ [ dup length 1 > [ flatten ] when , ] each ] each
|
||||
] { } make swap 1 -
|
||||
] while drop nip ;
|
||||
|
||||
: selections ( seq n -- selections )
|
||||
{
|
||||
{ 0 [ drop { } ] }
|
||||
{ 1 [ 1array ] }
|
||||
[ (selections) ]
|
||||
} case ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue