math.combinatorics.bits: new vocab for permutation-bits words.

extra/math/combinatorics/bits/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/math/combinatorics/bits/bits-docs.factor

@@ -0,0 +1,10 @@
+USING: help.markup help.syntax math sequences ;
+IN: math.combinatorics.bits
+
+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: all-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/combinatorics/bits/bits-tests.factor

@@ -0,0 +1,21 @@
+USING: math tools.test ;
+IN: math.combinatorics.bits
+
+{ 0b101 } [ 0b011 next-permutation-bits ] unit-test
+{ 0b110 } [ 0b101 next-permutation-bits ] unit-test
+
+{
+    {
+        0b00111 0b01011 0b01101 0b01110 0b10011
+        0b10101 0b10110 0b11001 0b11010 0b11100
+    }
+} [ 3 5 all-permutation-bits ] unit-test
+
+{ { 14 22 26 28 38 42 44 50 52 56 } } [ 3 5 [ 2 * ] map-permutation-bits ] unit-test
+
+{ V{ 14 22 26 28 } } [ 3 5 [ even? ] filter-permutation-bits ] unit-test
+
+{ 14 } [ 3 5 [ even? ] find-permutation-bits ] unit-test
+{ f } [ 3 5 [ 0 < ] find-permutation-bits ] unit-test
+
+{ 198 } [ 3 5 12 [ + ] reduce-permutation-bits ] unit-test

extra/math/combinatorics/bits/bits.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+USING: fry kernel math math.bitwise sequences ;
+IN: math.combinatorics.bits
+
+: next-permutation-bits ( v -- w )
+    [ dup 1 - bitor 1 + dup ] keep
+    [ dup neg bitand ] bi@ /i 2/ 1 - bitor ;
+
+<PRIVATE
+
+: permutation-bits-quot ( bit-count bits quot -- n pred body )
+    [ [ on-bits dup '[ dup _ >= ] ] [ on-bits ] bi* ] dip swap
+    '[ _ [ next-permutation-bits _ bitand ] bi ] ; inline
+
+PRIVATE>
+
+: each-permutation-bits ( ... bit-count bits quot: ( ... n -- ... ) -- ... )
+    permutation-bits-quot while drop ; inline
+
+: map-permutation-bits ( ... bit-count bits quot: ( ... n -- ... m ) -- ... seq )
+    permutation-bits-quot [ swap ] compose produce nip ; inline
+
+: filter-permutation-bits ( ... bit-count bits quot: ( ... n -- ... ? ) -- ... seq )
+    selector [ each-permutation-bits ] dip ; inline
+
+: all-permutation-bits ( bit-count bits -- seq )
+    [ ] map-permutation-bits ;
+
+: find-permutation-bits ( ... bit-count bits quot: ( ... n -- ... ? ) -- ... elt/f )
+    [ f f ] 3dip [ 2nip ] prepose [ keep swap ] curry
+    permutation-bits-quot [ [ pick not and ] compose ] dip
+    while drop swap and ; inline
+
+: reduce-permutation-bits ( ... bit-count bits identity quot: ( ... prev elt -- ... next ) -- ... result )
+    [ -rot ] dip each-permutation-bits ; inline

extra/math/combinatorics/bits/summary.txt

@@ -0,0 +1 @@
+Bitwise permutations