module ToySolver.Combinatorial.HittingSet.Simple
( minimalHittingSets
, enumMinimalHittingSets
) where
import Control.Monad
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Set (Set)
import qualified Data.Set as Set
import ToySolver.Combinatorial.HittingSet.Util (maintainNoSupersets)
minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets = Set.fromList . minimalHittingSets' . Set.toList
enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets = nubOrd . minimalHittingSets' . Set.toList
minimalHittingSets' :: [IntSet] -> [IntSet]
minimalHittingSets' es = f es IntSet.empty
where
f :: [IntSet] -> IntSet -> [IntSet]
f [] hs = return hs
f es hs = do
v <- IntSet.toList $ IntSet.unions es
let hs' = IntSet.insert v hs
e <- es
guard $ v `IntSet.member` e
let es' = propagateChoice es v e
f es' hs'
propagateChoice :: [IntSet] -> Int -> IntSet -> [IntSet]
propagateChoice es v e = zs
where
xs = filter (v `IntSet.notMember`) es
ys = map (IntSet.filter (v <) . (`IntSet.difference` e)) xs
zs = maintainNoSupersets ys
nubOrd :: Ord a => [a] -> [a]
nubOrd = go Set.empty
where
go occurred (x:xs)
| x `Set.member` occurred = go occurred xs
| otherwise = x : go (Set.insert x occurred) xs
go _ [] = []