Paste: more combinatorics

Author: mrjbq7
Mode: factor
Date: Wed, 14 Jul 2010 15:55:42
Plain Text | 
USING: arrays combinators kernel make math math.combinatorics
math.ranges sequences sequences.deep ;

IN: combinatorics

: 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 ;

Annotation: some tests

Author: mrjbq7
Mode: factor
Date: Wed, 14 Jul 2010 15:56:00
Plain Text | 
[ { { } } ] [ { } 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

Annotation: some docs

Author: mrjbq7
Mode: factor
Date: Wed, 14 Jul 2010 16:05:48
Plain Text | 
HELP: all-subsets
{ $values { "seq" sequence } { "subsets" sequence } }
{ $description
    "Returns all the subsets of a sequence."
}
{ $examples
    { $example
        "USING: combinatorics ;"
        "{ 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: combinatorics ;"
        "{ 1 2 } 2 selections"
        "{ { 1 1 } { 1 2 } { 2 1 } { 2 2 } }"
    }
} ;

New Annotation

Summary:
Author:
Mode:
Body: