{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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 -> Options m -> m (Set IntSet, Set IntSet)
run prob
prob Options m
opt = Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop ((IntSet -> IntSet) -> Set IntSet -> Set IntSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map IntSet -> IntSet
complement (Options m -> Set IntSet
forall (m :: * -> *). Options m -> Set IntSet
optMaximalInterestingSets Options m
opt)) (Options m -> Set IntSet
forall (m :: * -> *). Options m -> Set IntSet
optMinimalUninterestingSets Options m
opt)
where
univ :: IntSet
univ :: IntSet
univ = prob -> IntSet
forall prob (m :: * -> *). IsProblem prob m => prob -> IntSet
universe prob
prob
complement :: IntSet -> IntSet
complement :: IntSet -> IntSet
complement = (IntSet
univ IntSet -> IntSet -> IntSet
`IntSet.difference`)
loop :: Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop :: Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop Set IntSet
comp_pos Set IntSet
neg = do
case Set IntSet -> Set IntSet -> Maybe IntSet
FredmanKhachiyan1996.checkDuality Set IntSet
neg Set IntSet
comp_pos of
Maybe IntSet
Nothing -> (Set IntSet, Set IntSet) -> m (Set IntSet, Set IntSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((IntSet -> IntSet) -> Set IntSet -> Set IntSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map IntSet -> IntSet
complement Set IntSet
comp_pos, Set IntSet
neg)
Just IntSet
xs -> do
InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
minimalUninterestingSetOrMaximalInterestingSet prob
prob IntSet
xs
case InterestingOrUninterestingSet
ret of
UninterestingSet IntSet
ys -> do
Options m -> IntSet -> m ()
forall (m :: * -> *). Options m -> IntSet -> m ()
optOnMinimalUninterestingSetFound Options m
opt IntSet
ys
Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop Set IntSet
comp_pos (IntSet -> Set IntSet -> Set IntSet
forall a. Ord a => a -> Set a -> Set a
Set.insert IntSet
ys Set IntSet
neg)
InterestingSet IntSet
ys -> do
Options m -> IntSet -> m ()
forall (m :: * -> *). Options m -> IntSet -> m ()
optOnMaximalInterestingSetFound Options m
opt IntSet
ys
Set IntSet -> Set IntSet -> m (Set IntSet, Set IntSet)
loop (IntSet -> Set IntSet -> Set IntSet
forall a. Ord a => a -> Set a -> Set a
Set.insert (IntSet -> IntSet
complement IntSet
ys) Set IntSet
comp_pos) Set IntSet
neg
findPrimeImplicateOrPrimeImplicant
:: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant :: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant IntSet
vs IntSet -> Bool
f Set IntSet
cs Set IntSet
ds = do
IntSet
xs <- Set IntSet -> Set IntSet -> Maybe IntSet
FredmanKhachiyan1996.checkDuality Set IntSet
ds Set IntSet
cs
let prob :: SimpleProblem m
prob = IntSet -> (IntSet -> Bool) -> SimpleProblem m
forall (m :: * -> *). IntSet -> (IntSet -> Bool) -> SimpleProblem m
SimpleProblem IntSet
vs (Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Bool
f)
case Identity InterestingOrUninterestingSet
-> InterestingOrUninterestingSet
forall a. Identity a -> a
runIdentity (SimpleProblem Identity
-> IntSet -> Identity InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
minimalUninterestingSetOrMaximalInterestingSet SimpleProblem Identity
forall (m :: * -> *). SimpleProblem m
prob IntSet
xs) of
UninterestingSet IntSet
ys -> ImplicateOrImplicant -> Maybe ImplicateOrImplicant
forall (m :: * -> *) a. Monad m => a -> m a
return (IntSet -> ImplicateOrImplicant
Implicant IntSet
ys)
InterestingSet IntSet
ys -> ImplicateOrImplicant -> Maybe ImplicateOrImplicant
forall (m :: * -> *) a. Monad m => a -> m a
return (IntSet -> ImplicateOrImplicant
Implicate (IntSet
vs IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
ys))
generateCNFAndDNF
:: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> (Set IntSet, Set IntSet)
generateCNFAndDNF :: IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> (Set IntSet, Set IntSet)
generateCNFAndDNF IntSet
vs IntSet -> Bool
f Set IntSet
cs Set IntSet
ds = ((IntSet -> IntSet) -> Set IntSet -> Set IntSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (IntSet
vs IntSet -> IntSet -> IntSet
`IntSet.difference`) Set IntSet
pos, Set IntSet
neg)
where
prob :: SimpleProblem m
prob = IntSet -> (IntSet -> Bool) -> SimpleProblem m
forall (m :: * -> *). IntSet -> (IntSet -> Bool) -> SimpleProblem m
SimpleProblem IntSet
vs (Bool -> Bool
not (Bool -> Bool) -> (IntSet -> Bool) -> IntSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Bool
f)
opt :: Options Identity
opt = Options Identity
forall a. Default a => a
def
{ optMaximalInterestingSets :: Set IntSet
optMaximalInterestingSets = (IntSet -> IntSet) -> Set IntSet -> Set IntSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (IntSet
vs IntSet -> IntSet -> IntSet
`IntSet.difference`) Set IntSet
cs
, optMinimalUninterestingSets :: Set IntSet
optMinimalUninterestingSets = Set IntSet
ds
}
(Set IntSet
pos,Set IntSet
neg) = Identity (Set IntSet, Set IntSet) -> (Set IntSet, Set IntSet)
forall a. Identity a -> a
runIdentity (Identity (Set IntSet, Set IntSet) -> (Set IntSet, Set IntSet))
-> Identity (Set IntSet, Set IntSet) -> (Set IntSet, Set IntSet)
forall a b. (a -> b) -> a -> b
$ SimpleProblem Identity
-> Options Identity -> Identity (Set IntSet, Set IntSet)
forall (m :: * -> *) prob.
IsProblem prob m =>
prob -> Options m -> m (Set IntSet, Set IntSet)
run SimpleProblem Identity
forall (m :: * -> *). SimpleProblem m
prob Options Identity
opt
minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets :: Set IntSet -> Set IntSet
minimalHittingSets = [IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList ([IntSet] -> Set IntSet)
-> (Set IntSet -> [IntSet]) -> Set IntSet -> Set IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set IntSet -> [IntSet]
enumMinimalHittingSets
enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets :: Set IntSet -> [IntSet]
enumMinimalHittingSets Set IntSet
dnf = Set IntSet -> [IntSet]
loop Set IntSet
forall a. Set a
Set.empty
where
vs :: IntSet
vs = [IntSet] -> IntSet
forall (f :: * -> *). Foldable f => f IntSet -> IntSet
IntSet.unions ([IntSet] -> IntSet) -> [IntSet] -> IntSet
forall a b. (a -> b) -> a -> b
$ Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList Set IntSet
dnf
f :: IntSet -> Bool
f = Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
dnf
loop :: Set IntSet -> [IntSet]
loop :: Set IntSet -> [IntSet]
loop Set IntSet
cs =
case IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant IntSet
vs IntSet -> Bool
f Set IntSet
cs Set IntSet
dnf of
Maybe ImplicateOrImplicant
Nothing -> []
Just (Implicate IntSet
c) -> IntSet
c IntSet -> [IntSet] -> [IntSet]
forall a. a -> [a] -> [a]
: Set IntSet -> [IntSet]
loop (IntSet -> Set IntSet -> Set IntSet
forall a. Ord a => a -> Set a -> Set a
Set.insert IntSet
c Set IntSet
cs)
Just (Implicant IntSet
_) -> [Char] -> [IntSet]
forall a. HasCallStack => [Char] -> a
error [Char]
"GurvichKhachiyan1999.enumMinimalHittingSets: should not happen"
evalDNF :: Set IntSet -> IntSet -> Bool
evalDNF :: Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
dnf IntSet
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [IntSet
is IntSet -> IntSet -> Bool
`IntSet.isSubsetOf` IntSet
xs | IntSet
is <- Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList Set IntSet
dnf]
_evalCNF :: Set IntSet -> IntSet -> Bool
_evalCNF :: Set IntSet -> IntSet -> Bool
_evalCNF Set IntSet
cnf IntSet
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntSet -> Bool
IntSet.null (IntSet -> Bool) -> IntSet -> Bool
forall a b. (a -> b) -> a -> b
$ IntSet
is IntSet -> IntSet -> IntSet
`IntSet.intersection` IntSet
xs | IntSet
is <- Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList Set IntSet
cnf]
_f, _g :: Set IntSet
_f :: Set IntSet
_f = [IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList ([IntSet] -> Set IntSet) -> [IntSet] -> Set IntSet
forall a b. (a -> b) -> a -> b
$ ([Key] -> IntSet) -> [[Key]] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map [Key] -> IntSet
IntSet.fromList [[Key
2,Key
4,Key
7], [Key
7,Key
8], [Key
9]]
_g :: Set IntSet
_g = [IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList ([IntSet] -> Set IntSet) -> [IntSet] -> Set IntSet
forall a b. (a -> b) -> a -> b
$ ([Key] -> IntSet) -> [[Key]] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map [Key] -> IntSet
IntSet.fromList [[Key
7,Key
9], [Key
4,Key
8,Key
9], [Key
2,Key
8,Key
9]]
_testA1, _testA2, _testA3, _testA4 :: Maybe ImplicateOrImplicant
_testA1 :: Maybe ImplicateOrImplicant
_testA1 = IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant ([Key] -> IntSet
IntSet.fromList [Key
2,Key
4,Key
7,Key
8,Key
9]) (Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
_f) Set IntSet
forall a. Set a
Set.empty Set IntSet
_f
_testA2 :: Maybe ImplicateOrImplicant
_testA2 = IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant ([Key] -> IntSet
IntSet.fromList [Key
2,Key
4,Key
7,Key
8,Key
9]) (Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
_f) (IntSet -> Set IntSet
forall a. a -> Set a
Set.singleton ([Key] -> IntSet
IntSet.fromList [Key
2,Key
8,Key
9])) Set IntSet
_f
_testA3 :: Maybe ImplicateOrImplicant
_testA3 = IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant ([Key] -> IntSet
IntSet.fromList [Key
2,Key
4,Key
7,Key
8,Key
9]) (Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
_f) ([IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList [[Key] -> IntSet
IntSet.fromList [Key
2,Key
8,Key
9], [Key] -> IntSet
IntSet.fromList [Key
4,Key
8,Key
9]]) Set IntSet
_f
_testA4 :: Maybe ImplicateOrImplicant
_testA4 = IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant ([Key] -> IntSet
IntSet.fromList [Key
2,Key
4,Key
7,Key
8,Key
9]) (Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
_f) ([IntSet] -> Set IntSet
forall a. Ord a => [a] -> Set a
Set.fromList [[Key] -> IntSet
IntSet.fromList [Key
2,Key
8,Key
9], [Key] -> IntSet
IntSet.fromList [Key
4,Key
8,Key
9], [Key] -> IntSet
IntSet.fromList [Key
7,Key
9]]) Set IntSet
_f
_testB1 :: Maybe ImplicateOrImplicant
_testB1 :: Maybe ImplicateOrImplicant
_testB1 = IntSet
-> (IntSet -> Bool)
-> Set IntSet
-> Set IntSet
-> Maybe ImplicateOrImplicant
findPrimeImplicateOrPrimeImplicant ([Key] -> IntSet
IntSet.fromList [Key
2,Key
4,Key
7,Key
8,Key
9]) (Set IntSet -> IntSet -> Bool
evalDNF Set IntSet
_f) Set IntSet
_g Set IntSet
forall a. Set a
Set.empty