{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module ToySolver.Combinatorial.HittingSet.GurvichKhachiyan1999
(
module ToySolver.Combinatorial.HittingSet.InterestingSets
, run
, findPrimeImplicateOrPrimeImplicant
, generateCNFAndDNF
, minimalHittingSets
, enumMinimalHittingSets
) 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 qualified ToySolver.Combinatorial.HittingSet.FredmanKhachiyan1996 as FredmanKhachiyan1996
import ToySolver.Combinatorial.HittingSet.InterestingSets
run :: forall m prob. IsProblem prob m => prob -> Options m -> m (Set IntSet, Set IntSet)
run prob opt = loop (Set.map complement (optMaximalInterestingSets opt)) (optMinimalUninterestingSets opt)
where
univ :: IntSet
univ = universe prob
complement :: IntSet -> IntSet
complement = (univ `IntSet.difference`)
loop :: Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop comp_pos neg = do
case FredmanKhachiyan1996.checkDuality neg comp_pos of
Nothing -> return (Set.map complement comp_pos, neg)
Just xs -> do
ret <- minimalUninterestingSetOrMaximalInterestingSet prob xs
case ret of
UninterestingSet ys -> do
optOnMinimalUninterestingSetFound opt ys
loop comp_pos (Set.insert ys neg)
InterestingSet ys -> do
optOnMaximalInterestingSetFound opt ys
loop (Set.insert (complement ys) comp_pos) neg
findPrimeImplicateOrPrimeImplicant
:: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant vs f cs ds = do
xs <- FredmanKhachiyan1996.checkDuality ds cs
let prob = SimpleProblem vs (not . f)
case runIdentity (minimalUninterestingSetOrMaximalInterestingSet prob xs) of
UninterestingSet ys -> return (Implicant ys)
InterestingSet ys -> return (Implicate (vs `IntSet.difference` ys))
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
minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets = Set.fromList . enumMinimalHittingSets
enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets dnf = loop Set.empty
where
vs = IntSet.unions $ Set.toList dnf
f = evalDNF dnf
loop :: Set IntSet -> [IntSet]
loop cs =
case findPrimeImplicateOrPrimeImplicant vs f cs dnf of
Nothing -> []
Just (Implicate c) -> c : loop (Set.insert c cs)
Just (Implicant _) -> error "GurvichKhachiyan1999.enumMinimalHittingSets: should not happen"
evalDNF :: Set IntSet -> IntSet -> Bool
evalDNF dnf xs = or [is `IntSet.isSubsetOf` xs | is <- Set.toList dnf]
_evalCNF :: Set IntSet -> IntSet -> Bool
_evalCNF cnf xs = and [not $ IntSet.null $ is `IntSet.intersection` xs | is <- Set.toList cnf]
f, g :: Set IntSet
f = Set.fromList $ map IntSet.fromList [[2,4,7], [7,8], [9]]
g = Set.fromList $ map IntSet.fromList [[7,9], [4,8,9], [2,8,9]]
testA1, testA2, testA3, testA4 :: Maybe ImplicateOrImplicant
testA1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) Set.empty f
testA2 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.singleton (IntSet.fromList [2,8,9])) f
testA3 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9]]) f
testA4 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) (Set.fromList [IntSet.fromList [2,8,9], IntSet.fromList [4,8,9], IntSet.fromList [7,9]]) f
testB1 :: Maybe ImplicateOrImplicant
testB1 = findPrimeImplicateOrPrimeImplicant (IntSet.fromList [2,4,7,8,9]) (evalDNF f) g Set.empty