37 lines
1.3 KiB
Factor
37 lines
1.3 KiB
Factor
! 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
|