{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ToySolver.Combinatorial.HittingSet.DAA
(
module ToySolver.Combinatorial.HittingSet.InterestingSets
, run
, generateCNFAndDNF
) where
import Control.Monad.Identity
import Data.Default.Class
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Set (Set)
import qualified Data.Set as Set
import ToySolver.Combinatorial.HittingSet.InterestingSets
import ToySolver.Combinatorial.HittingSet.Util (maintainNoSupersets)
run :: forall prob m. IsProblem prob m => prob -> Options m -> m (Set IntSet, Set IntSet)
run prob opt = do
let comp_pos = Set.map complement (optMaximalInterestingSets opt)
hst_comp_pos <- optMinimalHittingSets opt comp_pos
loop comp_pos hst_comp_pos (optMinimalUninterestingSets opt)
where
univ :: IntSet
univ = universe prob
complement :: IntSet -> IntSet
complement = (univ `IntSet.difference`)
loop :: Set IntSet -> Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop comp_pos hst_comp_pos neg = do
let xss = hst_comp_pos `Set.difference` neg
if Set.null xss then
return (Set.map complement comp_pos, neg)
else do
(comp_pos', hst_comp_pos', neg') <- loop2 comp_pos hst_comp_pos neg (Set.toList xss)
loop comp_pos' hst_comp_pos' neg'
loop2 :: Set IntSet -> Set IntSet -> Set IntSet -> [IntSet] -> m (Set IntSet, Set IntSet, Set IntSet)
loop2 comp_pos hst_comp_pos neg [] = return (comp_pos, hst_comp_pos, neg)
loop2 comp_pos hst_comp_pos neg (xs : xss) = do
ret <- maximalInterestingSet prob xs
case ret of
Nothing -> do
optOnMinimalUninterestingSetFound opt xs
loop2 comp_pos hst_comp_pos (Set.insert xs neg) xss
Just ys -> do
optOnMaximalInterestingSetFound opt ys
let zs = complement ys
comp_pos' = Set.insert zs comp_pos
hst_comp_pos' = Set.fromList $ maintainNoSupersets $
[IntSet.insert w ws | ws <- Set.toList hst_comp_pos, w <- IntSet.toList zs]
return (comp_pos', hst_comp_pos', neg)
generateCNFAndDNF
:: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> (Set IntSet, Set IntSet)
generateCNFAndDNF vs f cs ds = (Set.map (vs `IntSet.difference`) pos, neg)
where
prob = SimpleProblem vs (not . f)
opt = def
{ optMaximalInterestingSets = Set.map (vs `IntSet.difference`) cs
, optMinimalUninterestingSets = ds
}
(pos,neg) = runIdentity $ run prob opt