{-# 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.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
/= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c/= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
== :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$c== :: 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
min :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
$cmin :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
max :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
$cmax :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> InterestingOrUninterestingSet
>= :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Bool
$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
compare :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Ordering
$ccompare :: InterestingOrUninterestingSet
-> InterestingOrUninterestingSet -> Ordering
$cp1Ord :: Eq 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
showList :: [InterestingOrUninterestingSet] -> ShowS
$cshowList :: [InterestingOrUninterestingSet] -> ShowS
show :: InterestingOrUninterestingSet -> String
$cshow :: InterestingOrUninterestingSet -> String
showsPrec :: Int -> InterestingOrUninterestingSet -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [InterestingOrUninterestingSet]
$creadListPrec :: ReadPrec [InterestingOrUninterestingSet]
readPrec :: ReadPrec InterestingOrUninterestingSet
$creadPrec :: ReadPrec InterestingOrUninterestingSet
readList :: ReadS [InterestingOrUninterestingSet]
$creadList :: ReadS [InterestingOrUninterestingSet]
readsPrec :: Int -> ReadS InterestingOrUninterestingSet
$creadsPrec :: Int -> ReadS 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 (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 (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 :: 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
forall (m :: * -> *). IsProblem prob m => 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 (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs'
        InterestingSet IntSet
xs'' -> IntSet -> m IntSet
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 :: 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
forall (m :: * -> *). IsProblem prob m => 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 (m :: * -> *) a. Monad m => a -> m a
return IntSet
xs''
        InterestingSet IntSet
_ -> IntSet -> m IntSet
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 :: 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 (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 :: 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 (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 :: 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 :: * -> *) = 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 (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
  { Options m -> Set IntSet -> m (Set IntSet)
optMinimalHittingSets :: Set IntSet -> m (Set IntSet)
  , Options m -> Set IntSet
optMaximalInterestingSets :: Set IntSet
  , Options m -> Set IntSet
optMinimalUninterestingSets :: Set IntSet
  , Options m -> IntSet -> m ()
optOnMaximalInterestingSetFound :: IntSet -> m ()
  , Options m -> IntSet -> m ()
optOnMinimalUninterestingSetFound :: IntSet -> m ()
  }

instance Monad m => Default (Options m) where
  def :: Options m
def =
    Options :: forall (m :: * -> *).
(Set IntSet -> m (Set IntSet))
-> Set IntSet
-> Set IntSet
-> (IntSet -> m ())
-> (IntSet -> m ())
-> Options m
Options
    { optMinimalHittingSets :: Set IntSet -> m (Set IntSet)
optMinimalHittingSets = Set IntSet -> m (Set IntSet)
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 (m :: * -> *) a. Monad m => a -> m a
return ()
    , optOnMinimalUninterestingSetFound :: IntSet -> m ()
optOnMinimalUninterestingSetFound = \IntSet
_ -> () -> m ()
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
/= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c/= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
== :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$c== :: 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
min :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
$cmin :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
max :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
$cmax :: ImplicateOrImplicant
-> ImplicateOrImplicant -> ImplicateOrImplicant
>= :: ImplicateOrImplicant -> ImplicateOrImplicant -> Bool
$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
compare :: ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering
$ccompare :: ImplicateOrImplicant -> ImplicateOrImplicant -> Ordering
$cp1Ord :: Eq 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
showList :: [ImplicateOrImplicant] -> ShowS
$cshowList :: [ImplicateOrImplicant] -> ShowS
show :: ImplicateOrImplicant -> String
$cshow :: ImplicateOrImplicant -> String
showsPrec :: Int -> ImplicateOrImplicant -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [ImplicateOrImplicant]
$creadListPrec :: ReadPrec [ImplicateOrImplicant]
readPrec :: ReadPrec ImplicateOrImplicant
$creadPrec :: ReadPrec ImplicateOrImplicant
readList :: ReadS [ImplicateOrImplicant]
$creadList :: ReadS [ImplicateOrImplicant]
readsPrec :: Int -> ReadS ImplicateOrImplicant
$creadsPrec :: Int -> ReadS ImplicateOrImplicant
Read)