math.combinatorics: adding a k-permutations virtual sequence.

basis/math/combinatorics/combinatorics-docs.factor

@@ -40,6 +40,10 @@ HELP: <permutations>
 { $values { "seq" sequence } { "permutations" sequence } }
 { $description "An efficient sequence containing the lexicographical permutations of " { $snippet "seq" } "." } ;
 
+HELP: <k-permutations>
+{ $values { "seq" sequence } { "k" integer } { "permutations" sequence } }
+{ $description "An efficient sequence containing the " { $snippet "k" } " 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." }

basis/math/combinatorics/combinatorics-tests.factor

@@ -1,4 +1,5 @@
-USING: kernel math math.combinatorics math.combinatorics.private tools.test sequences ;
+USING: arrays kernel math math.combinatorics
+math.combinatorics.private tools.test sequences ;
 IN: math.combinatorics.tests
 
 [ 1 ] [ -1 factorial ] unit-test ! required by other math.combinatorics words
@@ -99,3 +100,9 @@ IN: math.combinatorics.tests
 
 { f } [ { 1 2 3 } [ last 4 = ] find-permutation ] unit-test
 { { 2 1 3 } } [ { 1 2 3 } [ first 2 = ] find-permutation ] unit-test
+
+{ { { 0 1 2 } { 0 2 1 } { 1 0 2 } { 1 2 0 } { 2 0 1 } { 2 1 0 } } }
+[ 3 iota <permutations> >array ] unit-test
+
+{ { "as" "ad" "af" "sa" "sd" "sf" "da" "ds" "df" "fa" "fs" "fd" } }
+[ "asdf" 2 <k-permutations> >array ] unit-test

basis/math/combinatorics/combinatorics.factor

@@ -65,6 +65,24 @@ M: permutations hashcode* tuple-hashcode ;
 
 INSTANCE: permutations immutable-sequence
 
+TUPLE: k-permutations length skip k seq ;
+
+:: <k-permutations> ( seq k -- permutations )
+    seq length :> n
+    n k nPk :> len
+    len zero? k zero? or [ { } ] [
+        len n factorial over /i k seq k-permutations boa
+    ] if ;
+
+M: k-permutations length length>> ; inline
+M: k-permutations nth-unsafe
+    [ skip>> * ]
+    [ seq>> [ permutation-indices ] keep ]
+    [ k>> swap [ head ] dip nths-unsafe ] tri ;
+M: k-permutations hashcode* tuple-hashcode ;
+
+INSTANCE: k-permutations immutable-sequence
+
 DEFER: next-permutation
 
 <PRIVATE