math.extras: adding bitwise permutation words.

extra/math/extras/extras-docs.factor

@@ -86,3 +86,11 @@ HELP: round-to-decimal
     { $example "USING: math.extras prettyprint ;" "1.23456 2 round-to-decimal ." "1.23" }
     { $example "USING: math.extras prettyprint ;" "12345.6789 -3 round-to-decimal ." "12000.0" }
 } ;
+
+HELP: next-permutation-bits
+{ $values { "v" integer } { "w" integer } }
+{ $description "Generates the next bitwise permutation with the same number of set bits, given a previous lexicographical value." } ;
+
+HELP: permutation-bits
+{ $values { "bit-count" integer } { "bits" integer } { "seq" sequence } }
+{ $description "Generates all permutations of numbers with a given bit-count and number of bits." } ;

extra/math/extras/extras-tests.factor

@@ -129,3 +129,13 @@ IN: math.extras.test
 { 5 } [ 3 5 round-to-step ] unit-test
 { 10 } [ 12 5 round-to-step ] unit-test
 { 15 } [ 13 5 round-to-step ] unit-test
+
+{ 0b101 } [ 0b11 next-permutation-bits ] unit-test
+{ 0b110 } [ 0b101 next-permutation-bits ] unit-test
+
+{
+    {
+        0b00111 0b01011 0b01101 0b01110 0b10011
+        0b10101 0b10110 0b11001 0b11010 0b11100
+    }
+} [ 3 5 permutation-bits ] unit-test

extra/math/extras/extras.factor

@@ -3,8 +3,8 @@
 
 USING: accessors arrays assocs assocs.extras byte-arrays
 combinators combinators.short-circuit compression.zlib fry
-grouping kernel locals math math.combinatorics math.constants
-math.functions math.order math.primes math.ranges
+grouping kernel locals math math.bitwise math.combinatorics
+math.constants math.functions math.order math.primes math.ranges
 math.ranges.private math.statistics math.vectors memoize random
 sequences sequences.extras sets sorting ;
 
@@ -258,3 +258,12 @@ M: float round-to-even
 
 : round-to-step ( x step -- y )
     [ [ / round ] [ * ] bi ] unless-zero ;
+
+: next-permutation-bits ( v -- w )
+    [ dup 1 - bitor 1 + dup ] keep
+    [ dup neg bitand ] bi@ / -1 shift 1 - bitor ;
+
+: permutation-bits ( bit-count bits -- seq )
+    [ on-bits dup '[ dup _ >= ] ]
+    [ on-bits '[ [ next-permutation-bits _ bitand ] keep ] ]
+    bi* produce nip ;