math.combinatorics: adding <combinations> and <permutations> sequences.

db4
John Benediktsson 2012-04-23 08:29:20 -07:00
parent 7ad089b682
commit b9bcfdab8e
2 changed files with 35 additions and 5 deletions

View File

@ -36,6 +36,10 @@ HELP: permutation
"5 { \"apple\" \"banana\" \"orange\" } permutation ." "{ \"orange\" \"banana\" \"apple\" }" } "5 { \"apple\" \"banana\" \"orange\" } permutation ." "{ \"orange\" \"banana\" \"apple\" }" }
} ; } ;
HELP: <permutations>
{ $values { "seq" sequence } { "permutations" sequence } }
{ $description "An efficient sequence containing the lexicographical permutations of " { $snippet "seq" } "." } ;
HELP: all-permutations HELP: all-permutations
{ $values { "seq" sequence } { "seq'" sequence } } { $values { "seq" sequence } { "seq'" sequence } }
{ $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." } { $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\" }" } "0 { \"a\" \"b\" \"c\" \"d\" } 2 combination ." "{ \"a\" \"b\" }" }
} ; } ;
HELP: <combinations>
{ $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 HELP: all-combinations
{ $values { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } } { $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." } { $description "Outputs a sequence containing all combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements, in lexicographical order." }

View File

@ -1,8 +1,9 @@
! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer, John Benediktsson. ! Copyright (c) 2007-2010 Slava Pestov, Doug Coleman, Aaron Schaefer, John Benediktsson.
! 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 classes.tuple fry
math math.order math.ranges namespaces sequences sorting ; kernel locals math math.order math.ranges namespaces sequences
sequences.private sorting ;
IN: math.combinatorics IN: math.combinatorics
@ -50,9 +51,16 @@ PRIVATE>
: permutation ( n seq -- seq' ) : permutation ( n seq -- seq' )
[ permutation-indices ] keep nths ; [ permutation-indices ] keep nths ;
: all-permutations ( seq -- seq' ) TUPLE: permutations length seq ;
[ permutation-iota ] keep
'[ _ permutation ] map ; : <permutations> ( 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 -- ) : each-permutation ( seq quot -- )
[ [ permutation-iota ] keep ] dip [ [ permutation-iota ] keep ] dip
@ -65,6 +73,9 @@ PRIVATE>
: filter-permutations ( seq quot -- seq' ) : filter-permutations ( seq quot -- seq' )
selector [ each-permutation ] dip ; inline selector [ each-permutation ] dip ; inline
: all-permutations ( seq -- seq' )
[ ] map-permutations ;
: find-permutation ( seq quot -- elt ) : find-permutation ( seq quot -- elt )
[ dup [ permutation-iota ] keep ] dip [ dup [ permutation-iota ] keep ] dip
'[ _ permutation @ ] find drop '[ _ permutation @ ] find drop
@ -150,6 +161,17 @@ PRIVATE>
: combination ( m seq k -- seq' ) : combination ( m seq k -- seq' )
<combo> apply-combination ; <combo> apply-combination ;
TUPLE: combinations combo length ;
: <combinations> ( seq k -- combinations )
[ <combo> ] 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 -- ) : each-combination ( seq k quot -- )
combinations-quot each ; inline combinations-quot each ; inline