{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Combinatorial.HittingSet.InterestingSets
-- Copyright   :  (c) Masahiro Sakai 2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- * D. Gunopulos, H. Mannila, R. Khardon, and H. Toivonen, Data mining,
--   hypergraph transversals, and machine learning (extended abstract),
--   in Proceedings of the Sixteenth ACM SIGACT-SIGMOD-SIGART Symposium
--   on Principles of Database Systems, ser. PODS '97. 1997, pp. 209-216.
--   <http://almaden.ibm.com/cs/projects/iis/hdb/Publications/papers/pods97_trans.pdf>
--
-----------------------------------------------------------------------------
module ToySolver.Combinatorial.HittingSet.InterestingSets
  (
  -- * Problem definition
    IsProblem (..)
  , InterestingOrUninterestingSet (..)
  , defaultGrow
  , defaultShrink
  , defaultMaximalInterestingSet
  , defaultMinimalUninterestingSet
  , defaultMinimalUninterestingSetOrMaximalInterestingSet
  , SimpleProblem (..)

  -- * Options for maximal interesting sets enumeration
  , Options (..)

  -- * Datatype for monotone CNF/DNF dualization
  , ImplicateOrImplicant (..)
  ) where

import Control.Monad
import Data.Default.Class
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Kind (Type)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified ToySolver.Combinatorial.HittingSet.Simple as HTC

data InterestingOrUninterestingSet
  = UninterestingSet IntSet
  | InterestingSet IntSet
  deriving (InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
(InterestingOrUninterestingSet
 -> InterestingOrUninterestingSet -> Bool)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> Bool)
-> Eq InterestingOrUninterestingSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
== :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c/= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
/= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
Eq, Eq InterestingOrUninterestingSet
Eq InterestingOrUninterestingSet =>
(InterestingOrUninterestingSet
 -> InterestingOrUninterestingSet -> Ordering)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> Bool)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> Bool)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> Bool)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> Bool)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> InterestingOrUninterestingSet)
-> (InterestingOrUninterestingSet
    -> InterestingOrUninterestingSet -> InterestingOrUninterestingSet)
-> Ord InterestingOrUninterestingSet
InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Ordering
InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Ordering
compare :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Ordering
$c< :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
< :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c<= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
<= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c> :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
> :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c>= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
>= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$cmax :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
max :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
$cmin :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
min :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
Ord, Int -> InterestingOrUninterestingSet -> ShowS
[InterestingOrUninterestingSet] -> ShowS
InterestingOrUninterestingSet -> String
(Int -> InterestingOrUninterestingSet -> ShowS)
-> (InterestingOrUninterestingSet -> String)
-> ([InterestingOrUninterestingSet] -> ShowS)
-> Show InterestingOrUninterestingSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InterestingOrUninterestingSet -> ShowS
showsPrec :: Int -> InterestingOrUninterestingSet -> ShowS
$cshow :: InterestingOrUninterestingSet -> String
show :: InterestingOrUninterestingSet -> String
$cshowList :: [InterestingOrUninterestingSet] -> ShowS
showList :: [InterestingOrUninterestingSet] -> ShowS
Show, ReadPrec [InterestingOrUninterestingSet]
ReadPrec InterestingOrUninterestingSet
Int -> ReadS InterestingOrUninterestingSet
ReadS [InterestingOrUninterestingSet]
(Int -> ReadS InterestingOrUninterestingSet)
-> ReadS [InterestingOrUninterestingSet]
-> ReadPrec InterestingOrUninterestingSet
-> ReadPrec [InterestingOrUninterestingSet]
-> Read InterestingOrUninterestingSet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS InterestingOrUninterestingSet
readsPrec :: Int -> ReadS InterestingOrUninterestingSet
$creadList :: ReadS [InterestingOrUninterestingSet]
readList :: ReadS [InterestingOrUninterestingSet]
$creadPrec :: ReadPrec InterestingOrUninterestingSet
readPrec :: ReadPrec InterestingOrUninterestingSet
$creadListPrec :: ReadPrec [InterestingOrUninterestingSet]
readListPrec :: ReadPrec [InterestingOrUninterestingSet]
Read)

-- | A problem is essentially a pair of an @IntSet@ (@universe@) and
-- a monotone pure function @IntSet -> Bool@ (@isInteresting@), but
-- we generalize a bit for potentialial optimization opportunity.
--
-- For simple cases you can just use 'SimpleProblem' instance.
class Monad m => IsProblem prob m | prob -> m where
  universe :: prob -> IntSet

  -- | Interesting sets are lower closed subsets of 'universe', i.e. if @xs@ is
  -- interesting then @ys@ ⊆ @xs@ is also interesting.
  isInteresting :: prob -> IntSet -> m Bool
  isInteresting prob
prob IntSet
xs = do
    InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob IntSet
xs
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$!
      case InterestingOrUninterestingSet
ret of
        InterestingSet IntSet
_ -> Bool
True
        UninterestingSet IntSet
_ -> Bool
False

  -- | If @xs@ is interesting it returns @InterestingSet ys@ where @ys@ is an interesting superset of @xs@.
  -- If @xs@ is uninteresting it returns @UninterestingSet ys@ where @ys@ is an uninteresting subset of @xs@.
  isInteresting' :: prob -> IntSet -> m InterestingOrUninterestingSet
  isInteresting' prob
prob IntSet
xs = do
    Bool
b <- prob -> IntSet -> m Bool
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m Bool
isInteresting prob
prob IntSet
xs
    InterestingOrUninterestingSet -> m InterestingOrUninterestingSet
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterestingOrUninterestingSet -> m InterestingOrUninterestingSet)
-> InterestingOrUninterestingSet -> m InterestingOrUninterestingSet
forall a b. (a -> b) -> a -> b
$ if Bool
b then IntSet -> InterestingOrUninterestingSet
InterestingSet IntSet
xs else IntSet -> InterestingOrUninterestingSet
UninterestingSet IntSet
xs

  -- | @grow xs@ computes maximal interesting set @ys@ that is a superset of @xs@.
  grow :: prob -> IntSet -> m IntSet
  grow = prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
defaultGrow

  -- | @shrink xs@ computes minimal uninteresting set @ys@ that is a subset of @xs@.
  shrink :: prob -> IntSet -> m IntSet
  shrink = prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
defaultShrink

  -- | If @xs@ is an interesting set @maximalInterestingSet prob xs@ returns @Just ys@
  -- such that @ys@ is a maximal interesting superset of @xs@, otherwise it returns @Nothing@.
  maximalInterestingSet :: prob -> IntSet -> m (Maybe IntSet)
  maximalInterestingSet = prob -> IntSet -> m (Maybe IntSet)
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m (Maybe IntSet)
defaultMaximalInterestingSet

  -- | If @xs@ is an uninteresting set @minimalUninterestingSet prob xs@ returns @Just ys@
  -- such that @ys@ is a minimal uninteresting subset of @xs@, otherwise it returns @Nothing@.
  minimalUninterestingSet :: prob -> IntSet -> m (Maybe IntSet)
  minimalUninterestingSet = prob -> IntSet -> m (Maybe IntSet)
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m (Maybe IntSet)
defaultMinimalUninterestingSet

  -- | If @xs@ is an uninteresting set @minimalUninterestingSetOrMaximalInterestingSet prob xs@ returns @Left ys@
  -- such that @ys@ is a minimal uninteresting subset of @xs@.
  -- If @xs@ is an interesting set @minimalUninterestingSetOrMaximalInterestingSet prob xs@ returns @Right ys@
  -- such that @ys@ is a maximal interesting superset of @xs@
  minimalUninterestingSetOrMaximalInterestingSet :: prob -> IntSet -> m InterestingOrUninterestingSet
  minimalUninterestingSetOrMaximalInterestingSet = prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
defaultMinimalUninterestingSetOrMaximalInterestingSet

  {-# MINIMAL universe, (isInteresting | isInteresting') #-}

-- | Default implementation of 'grow' using 'isInteresting''.
defaultGrow :: IsProblem prob m => prob -> IntSet -> m IntSet
defaultGrow :: forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
defaultGrow prob
prob IntSet
xs = (IntSet -> Int -> m IntSet) -> IntSet -> [Int] -> m IntSet
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IntSet -> Int -> m IntSet
f IntSet
xs (IntSet -> [Int]
IntSet.toList (prob -> IntSet
forall prob (m :: * -> *). IsProblem prob m => prob -> IntSet
universe prob
prob IntSet -> IntSet -> IntSet
`IntSet.difference` IntSet
xs))
  where
    f :: IntSet -> Int -> m IntSet
f IntSet
xs' Int
y = do
      InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob (Int -> IntSet -> IntSet
IntSet.insert Int
y IntSet
xs')
      case InterestingOrUninterestingSet
ret of
        UninterestingSet IntSet
_ -> IntSet -> m IntSet
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs'
        InterestingSet IntSet
xs'' -> IntSet -> m IntSet
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs''

-- | Default implementation of 'shrink' using 'isInteresting''.
defaultShrink :: IsProblem prob m => prob -> IntSet -> m IntSet
defaultShrink :: forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
defaultShrink prob
prob IntSet
xs = (IntSet -> Int -> m IntSet) -> IntSet -> [Int] -> m IntSet
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IntSet -> Int -> m IntSet
f IntSet
xs (IntSet -> [Int]
IntSet.toList IntSet
xs)
  where
    f :: IntSet -> Int -> m IntSet
f IntSet
xs' Int
y = do
      InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob (Int -> IntSet -> IntSet
IntSet.delete Int
y IntSet
xs')
      case InterestingOrUninterestingSet
ret of
        UninterestingSet IntSet
xs'' -> IntSet -> m IntSet
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs''
        InterestingSet IntSet
_ -> IntSet -> m IntSet
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs'

-- | Default implementation of 'maximalUninterestingSet' using 'isInteresting'' and 'grow'.
defaultMaximalInterestingSet :: IsProblem prob m => prob -> IntSet -> m (Maybe IntSet)
defaultMaximalInterestingSet :: forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m (Maybe IntSet)
defaultMaximalInterestingSet prob
prob IntSet
xs = do
 InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob IntSet
xs
 case InterestingOrUninterestingSet
ret of
   UninterestingSet IntSet
_ -> Maybe IntSet -> m (Maybe IntSet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IntSet
forall a. Maybe a
Nothing
   InterestingSet IntSet
xs' -> (IntSet -> Maybe IntSet) -> m IntSet -> m (Maybe IntSet)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (m IntSet -> m (Maybe IntSet)) -> m IntSet -> m (Maybe IntSet)
forall a b. (a -> b) -> a -> b
$ prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
grow prob
prob IntSet
xs'

-- | Default implementation of 'minimalUninterestingSet' using 'isInteresting'' and 'shrink'.
defaultMinimalUninterestingSet :: IsProblem prob m => prob -> IntSet -> m (Maybe IntSet)
defaultMinimalUninterestingSet :: forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m (Maybe IntSet)
defaultMinimalUninterestingSet prob
prob IntSet
xs = do
 InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob IntSet
xs
 case InterestingOrUninterestingSet
ret of
   UninterestingSet IntSet
xs' -> (IntSet -> Maybe IntSet) -> m IntSet -> m (Maybe IntSet)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (m IntSet -> m (Maybe IntSet)) -> m IntSet -> m (Maybe IntSet)
forall a b. (a -> b) -> a -> b
$ prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
shrink prob
prob IntSet
xs'
   InterestingSet IntSet
_ -> Maybe IntSet -> m (Maybe IntSet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IntSet
forall a. Maybe a
Nothing

-- | Default implementation of 'minimalUninterestingSetOrMaximalInterestingSet' using 'isInteresting'', 'shrink' 'grow'.
defaultMinimalUninterestingSetOrMaximalInterestingSet
  :: IsProblem prob m => prob -> IntSet -> m InterestingOrUninterestingSet
defaultMinimalUninterestingSetOrMaximalInterestingSet :: forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
defaultMinimalUninterestingSetOrMaximalInterestingSet prob
prob IntSet
xs = do
 InterestingOrUninterestingSet
ret <- prob -> IntSet -> m InterestingOrUninterestingSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m InterestingOrUninterestingSet
isInteresting' prob
prob IntSet
xs
 case InterestingOrUninterestingSet
ret of
   UninterestingSet IntSet
ys -> (IntSet -> InterestingOrUninterestingSet)
-> m IntSet -> m InterestingOrUninterestingSet
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IntSet -> InterestingOrUninterestingSet
UninterestingSet (m IntSet -> m InterestingOrUninterestingSet)
-> m IntSet -> m InterestingOrUninterestingSet
forall a b. (a -> b) -> a -> b
$ prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
shrink prob
prob IntSet
ys
   InterestingSet IntSet
ys -> (IntSet -> InterestingOrUninterestingSet)
-> m IntSet -> m InterestingOrUninterestingSet
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IntSet -> InterestingOrUninterestingSet
InterestingSet (m IntSet -> m InterestingOrUninterestingSet)
-> m IntSet -> m InterestingOrUninterestingSet
forall a b. (a -> b) -> a -> b
$ prob -> IntSet -> m IntSet
forall prob (m :: * -> *).
IsProblem prob m =>
prob -> IntSet -> m IntSet
grow prob
prob IntSet
ys

data SimpleProblem (m :: Type -> Type) = SimpleProblem IntSet (IntSet -> Bool)

instance Monad m => IsProblem (SimpleProblem m) m where
  universe :: SimpleProblem m -> IntSet
universe (SimpleProblem IntSet
univ IntSet -> Bool
_) = IntSet
univ
  isInteresting :: SimpleProblem m -> IntSet -> m Bool
isInteresting (SimpleProblem IntSet
_ IntSet -> Bool
f) = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (IntSet -> Bool) -> IntSet -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Bool
f

data Options m
  = Options
  { forall (m :: * -> *). Options m -> Set IntSet -> m (Set IntSet)
optMinimalHittingSets :: Set IntSet -> m (Set IntSet)
  , forall (m :: * -> *). Options m -> Set IntSet
optMaximalInterestingSets :: Set IntSet
  , forall (m :: * -> *). Options m -> Set IntSet
optMinimalUninterestingSets :: Set IntSet
  , forall (m :: * -> *). Options m -> IntSet -> m ()
optOnMaximalInterestingSetFound :: IntSet -> m ()
  , forall (m :: * -> *). Options m -> IntSet -> m ()
optOnMinimalUninterestingSetFound :: IntSet -> m ()
  }

instance Monad m => Default (Options m) where
  def :: Options m
def =
    Options
    { optMinimalHittingSets :: Set IntSet -> m (Set IntSet)
optMinimalHittingSets = Set IntSet -> m (Set IntSet)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set IntSet -> m (Set IntSet))
-> (Set IntSet -> Set IntSet) -> Set IntSet -> m (Set IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set IntSet -> Set IntSet
HTC.minimalHittingSets
    , optMaximalInterestingSets :: Set IntSet
optMaximalInterestingSets = Set IntSet
forall a. Set a
Set.empty
    , optMinimalUninterestingSets :: Set IntSet
optMinimalUninterestingSets = Set IntSet
forall a. Set a
Set.empty
    , optOnMaximalInterestingSetFound :: IntSet -> m ()
optOnMaximalInterestingSetFound = \IntSet
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , optOnMinimalUninterestingSetFound :: IntSet -> m ()
optOnMinimalUninterestingSetFound = \IntSet
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }


data ImplicateOrImplicant
  = Implicate IntSet
  | Implicant IntSet
  deriving (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
(ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> Eq ImplicateOrImplicant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
== :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c/= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
/= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
Eq, Eq ImplicateOrImplicant
Eq ImplicateOrImplicant =>
(ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering)
-> (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> (ImplicateOrImplicant -> ImplicateOrImplicant -> Bool)
-> (ImplicateOrImplicant
    -> ImplicateOrImplicant -> ImplicateOrImplicant)
-> (ImplicateOrImplicant
    -> ImplicateOrImplicant -> ImplicateOrImplicant)
-> Ord ImplicateOrImplicant
ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering
ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering
compare :: ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering
$c< :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
< :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c<= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
<= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c> :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
> :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c>= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
>= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$cmax :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
max :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
$cmin :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
min :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
Ord, Int -> ImplicateOrImplicant -> ShowS
[ImplicateOrImplicant] -> ShowS
ImplicateOrImplicant -> String
(Int -> ImplicateOrImplicant -> ShowS)
-> (ImplicateOrImplicant -> String)
-> ([ImplicateOrImplicant] -> ShowS)
-> Show ImplicateOrImplicant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImplicateOrImplicant -> ShowS
showsPrec :: Int -> ImplicateOrImplicant -> ShowS
$cshow :: ImplicateOrImplicant -> String
show :: ImplicateOrImplicant -> String
$cshowList :: [ImplicateOrImplicant] -> ShowS
showList :: [ImplicateOrImplicant] -> ShowS
Show, ReadPrec [ImplicateOrImplicant]
ReadPrec ImplicateOrImplicant
Int -> ReadS ImplicateOrImplicant
ReadS [ImplicateOrImplicant]
(Int -> ReadS ImplicateOrImplicant)
-> ReadS [ImplicateOrImplicant]
-> ReadPrec ImplicateOrImplicant
-> ReadPrec [ImplicateOrImplicant]
-> Read ImplicateOrImplicant
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ImplicateOrImplicant
readsPrec :: Int -> ReadS ImplicateOrImplicant
$creadList :: ReadS [ImplicateOrImplicant]
readList :: ReadS [ImplicateOrImplicant]
$creadPrec :: ReadPrec ImplicateOrImplicant
readPrec :: ReadPrec ImplicateOrImplicant
$creadListPrec :: ReadPrec [ImplicateOrImplicant]
readListPrec :: ReadPrec [ImplicateOrImplicant]
Read)