diff --git a/basis/math/combinatorics/combinatorics-docs.factor b/basis/math/combinatorics/combinatorics-docs.factor index 0ae8c64428..b3fc7751e1 100644 --- a/basis/math/combinatorics/combinatorics-docs.factor +++ b/basis/math/combinatorics/combinatorics-docs.factor @@ -36,6 +36,10 @@ HELP: permutation "5 { \"apple\" \"banana\" \"orange\" } permutation ." "{ \"orange\" \"banana\" \"apple\" }" } } ; +HELP: +{ $values { "seq" sequence } { "permutations" sequence } } +{ $description "An efficient sequence containing the lexicographical permutations of " { $snippet "seq" } "." } ; + HELP: all-permutations { $values { "seq" sequence } { "seq'" sequence } } { $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." } @@ -70,6 +74,10 @@ HELP: combination "0 { \"a\" \"b\" \"c\" \"d\" } 2 combination ." "{ \"a\" \"b\" }" } } ; +HELP: +{ $values { "seq" sequence } { "k" "a non-negative integer" } { "combinations" sequence } } +{ $description "An efficient sequence containing the combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements." } ; + HELP: all-combinations { $values { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } } { $description "Outputs a sequence containing all combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements, in lexicographical order." } diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor index 6b9075d554..4f4a20d478 100644 --- a/basis/math/combinatorics/combinatorics.factor +++ b/basis/math/combinatorics/combinatorics.factor @@ -1,8 +1,9 @@ ! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer, John Benediktsson. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs binary-search fry kernel locals -math math.order math.ranges namespaces sequences sorting ; +USING: accessors arrays assocs binary-search classes.tuple fry +kernel locals math math.order math.ranges namespaces sequences +sequences.private sorting ; IN: math.combinatorics @@ -50,9 +51,16 @@ PRIVATE> : permutation ( n seq -- seq' ) [ permutation-indices ] keep nths ; -: all-permutations ( seq -- seq' ) - [ permutation-iota ] keep - '[ _ permutation ] map ; +TUPLE: permutations length seq ; + +: ( seq -- permutations ) + [ length factorial ] keep permutations boa ; + +M: permutations length length>> ; inline +M: permutations nth-unsafe seq>> permutation ; +M: permutations hashcode* tuple-hashcode ; + +INSTANCE: permutations immutable-sequence : each-permutation ( seq quot -- ) [ [ permutation-iota ] keep ] dip @@ -65,6 +73,9 @@ PRIVATE> : filter-permutations ( seq quot -- seq' ) selector [ each-permutation ] dip ; inline +: all-permutations ( seq -- seq' ) + [ ] map-permutations ; + : find-permutation ( seq quot -- elt ) [ dup [ permutation-iota ] keep ] dip '[ _ permutation @ ] find drop @@ -150,6 +161,17 @@ PRIVATE> : combination ( m seq k -- seq' ) apply-combination ; +TUPLE: combinations combo length ; + +: ( seq k -- combinations ) + [ ] 2keep [ length ] [ nCk ] bi* combinations boa ; + +M: combinations length length>> ; inline +M: combinations nth-unsafe combo>> apply-combination ; +M: combinations hashcode* tuple-hashcode ; + +INSTANCE: combinations immutable-sequence + : each-combination ( seq k quot -- ) combinations-quot each ; inline