module Math.SetCover.BitMap where
import qualified Math.SetCover.BitSet as BitSet
import qualified Math.SetCover.Bit as Bit
import Math.SetCover.BitSet (Set(Set))
import Math.SetCover.Bit (xor, (.|.), (.&.))
import Data.Monoid (Monoid, mempty, mappend)
newtype Map bits = Map {unMap :: [bits]} deriving (Show)
instance (Bit.C bits) => Monoid (Map bits) where
mempty = Map []
mappend = add
fromSet :: Bit.C bits => Set bits -> Map bits
fromSet (Set x) = Map [x]
add :: Bit.C bits => Map bits -> Map bits -> Map bits
add (Map xs0) (Map ys0) =
let go c xs [] = unMap $ inc (Set c) (Map xs)
go c [] ys = unMap $ inc (Set c) (Map ys)
go c (x:xs) (y:ys) =
xor c (xor x y) :
go (c.&.x .|. x.&.y .|. y.&.c) xs ys
in Map $ go Bit.empty xs0 ys0
inc :: Bit.C bits => Set bits -> Map bits -> Map bits
inc (Set xs0) (Map ys0) =
let go c [] = if c==Bit.empty then [] else [c]
go c (x:xs) = xor c x : go (c .&. x) xs
in Map $ go xs0 ys0
minimumSet :: Bit.C bits => Set bits -> Map bits -> Set bits
minimumSet baseSet (Map xs) =
foldr
(\x mins ->
case BitSet.difference mins $ Set x of
newMins ->
if BitSet.null newMins
then mins
else newMins)
baseSet xs