factor/extra/math/combinatorics/bits/bits.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 )
-rotd each-permutation-bits ; inline