diff --git a/extra/math/extras/extras-docs.factor b/extra/math/extras/extras-docs.factor index b6883d175e..cd477f8354 100644 --- a/extra/math/extras/extras-docs.factor +++ b/extra/math/extras/extras-docs.factor @@ -86,11 +86,3 @@ 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: 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." } ; diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor index 58e0744430..7a71bae69d 100644 --- a/extra/math/extras/extras-tests.factor +++ b/extra/math/extras/extras-tests.factor @@ -129,20 +129,3 @@ 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 } [ 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 diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor index 7762713584..d3b9515c70 100644 --- a/extra/math/extras/extras.factor +++ b/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.bitwise math.combinatorics -math.constants math.functions math.order math.primes math.ranges +grouping kernel locals math 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,35 +258,3 @@ 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@ /i 2/ 1 - bitor ; - -= ] ] [ 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