{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.DecisionDiagram.ZDD
-- Copyright   :  (c) Masahiro Sakai 2021
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  unstable
-- Portability :  non-portable
--
-- Zero-Suppressed binary decision diagram.
--
-- References:
--
-- * S. Minato, "Zero-Suppressed BDDs for Set Manipulation in Combinatorial Problems,"
--   30th ACM/IEEE Design Automation Conference, 1993, pp. 272-277,
--   doi: [10.1145/157485.164890](https://doi.org/10.1145/157485.164890).
--   <https://www.researchgate.net/publication/221062015_Zero-Suppressed_BDDs_for_Set_Manipulation_in_Combinatorial_Problems>
--
----------------------------------------------------------------------
module Data.DecisionDiagram.ZDD
  (
  -- * ZDD type
    ZDD (Leaf, Branch)
  , pattern Empty
  , pattern Base

  -- * Item ordering
  , ItemOrder (..)
  , AscOrder
  , DescOrder
  , withDefaultOrder
  , withAscOrder
  , withDescOrder
  , withCustomOrder

  -- * Construction
  , empty
  , base
  , singleton
  , subsets
  , combinations
  , fromListOfIntSets
  , fromSetOfIntSets

  -- ** Pseudo-boolean constraints
  , subsetsAtLeast
  , subsetsAtMost
  , subsetsExactly
  , subsetsExactlyIntegral

  -- * Insertion
  , insert

  -- * Deletion
  , delete

  -- * Query
  , member
  , notMember
  , null
  , size
  , isSubsetOf
  , isProperSubsetOf
  , disjoint
  , numNodes

  -- * Combine
  , union
  , unions
  , intersection
  , difference
  , (\\)
  , nonSuperset

  -- * Filter
  , subset1
  , subset0

  -- * Map
  , mapInsert
  , mapDelete
  , change

  -- * (Co)algebraic structure
  , Sig (..)
  , pattern SEmpty
  , pattern SBase
  , inSig
  , outSig

  -- * Fold
  , fold
  , fold'

  -- * Unfold
  , unfoldHashable
  , unfoldOrd

  -- * Minimal hitting sets
  , minimalHittingSets
  , minimalHittingSetsToda
  , minimalHittingSetsKnuth
  , minimalHittingSetsImai

  -- * Random sampling
  , uniformM

  -- * Min/Max
  , findMinSum
  , findMaxSum

  -- * Misc
  , flatten

  -- * Conversion
  , toListOfIntSets
  , toSetOfIntSets

  -- ** Conversion from/to graphs
  , Graph
  , toGraph
  , toGraph'
  , fromGraph
  , fromGraph'
  ) where

import Prelude hiding (null)

import Control.Monad
#if !MIN_VERSION_mwc_random(0,15,0)
import Control.Monad.Primitive
#endif
import Control.Monad.ST
import qualified Data.Foldable as Foldable
import Data.Function (on)
import Data.Hashable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.HashTable.Class as H
import qualified Data.HashTable.ST.Cuckoo as C
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List (foldl', sortBy)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.Maybe
import Data.Proxy
import Data.Ratio
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Vector as V
import qualified GHC.Exts as Exts
import GHC.Stack
import Numeric.Natural
#if MIN_VERSION_mwc_random(0,15,0)
import System.Random.Stateful (StatefulGen (..))
#else
import System.Random.MWC (Gen)
#endif
import System.Random.MWC.Distributions (bernoulli)
import Text.Read

import Data.DecisionDiagram.BDD.Internal.ItemOrder
import Data.DecisionDiagram.BDD.Internal.Node (Sig (..), Graph)
import qualified Data.DecisionDiagram.BDD.Internal.Node as Node
import qualified Data.DecisionDiagram.BDD as BDD

-- ------------------------------------------------------------------------

defaultTableSize :: Int
defaultTableSize :: Int
defaultTableSize = Int
256

-- ------------------------------------------------------------------------

-- | Zero-suppressed binary decision diagram representing family of sets
newtype ZDD a = ZDD Node.Node
  deriving (ZDD a -> ZDD a -> Bool
(ZDD a -> ZDD a -> Bool) -> (ZDD a -> ZDD a -> Bool) -> Eq (ZDD a)
forall a. ZDD a -> ZDD a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZDD a -> ZDD a -> Bool
$c/= :: forall a. ZDD a -> ZDD a -> Bool
== :: ZDD a -> ZDD a -> Bool
$c== :: forall a. ZDD a -> ZDD a -> Bool
Eq, Eq (ZDD a)
Eq (ZDD a)
-> (Int -> ZDD a -> Int) -> (ZDD a -> Int) -> Hashable (ZDD a)
Int -> ZDD a -> Int
ZDD a -> Int
forall a. Eq (ZDD a)
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall a. Int -> ZDD a -> Int
forall a. ZDD a -> Int
hash :: ZDD a -> Int
$chash :: forall a. ZDD a -> Int
hashWithSalt :: Int -> ZDD a -> Int
$chashWithSalt :: forall a. Int -> ZDD a -> Int
$cp1Hashable :: forall a. Eq (ZDD a)
Hashable)

-- | Synonym of @'Leaf' False@
pattern Empty :: ZDD a
pattern $bEmpty :: ZDD a
$mEmpty :: forall r a. ZDD a -> (Void# -> r) -> (Void# -> r) -> r
Empty = Leaf False

-- | Synonym of @'Leaf' True@
pattern Base :: ZDD a
pattern $bBase :: ZDD a
$mBase :: forall r a. ZDD a -> (Void# -> r) -> (Void# -> r) -> r
Base = Leaf True

pattern Leaf :: Bool -> ZDD a
pattern $bLeaf :: Bool -> ZDD a
$mLeaf :: forall r a. ZDD a -> (Bool -> r) -> (Void# -> r) -> r
Leaf b = ZDD (Node.Leaf b)

-- | Smart constructor that takes the ZDD reduction rules into account
pattern Branch :: Int -> ZDD a -> ZDD a -> ZDD a
pattern $bBranch :: Int -> ZDD a -> ZDD a -> ZDD a
$mBranch :: forall r a.
ZDD a -> (Int -> ZDD a -> ZDD a -> r) -> (Void# -> r) -> r
Branch x lo hi <- ZDD (Node.Branch x (ZDD -> lo) (ZDD -> hi)) where
  Branch Int
_ ZDD a
p0 ZDD a
Empty = ZDD a
p0
  Branch Int
x (ZDD Node
lo) (ZDD Node
hi) = Node -> ZDD a
forall a. Node -> ZDD a
ZDD (Int -> Node -> Node -> Node
Node.Branch Int
x Node
lo Node
hi)

{-# COMPLETE Empty, Base, Branch #-}
{-# COMPLETE Leaf, Branch #-}

-- Hack for avoiding spurious incomplete patterns warning on the above Branch pattern definition.
#if __GLASGOW_HASKELL__ < 810
{-# COMPLETE ZDD #-}
#endif

nodeId :: ZDD a -> Int
nodeId :: ZDD a -> Int
nodeId (ZDD Node
node) = Node -> Int
Node.nodeId Node
node

-- ------------------------------------------------------------------------

instance Show (ZDD a) where
  showsPrec :: Int -> ZDD a -> ShowS
showsPrec Int
d ZDD a
a   = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromGraph " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Graph Sig, Int) -> ShowS
forall a. Show a => a -> ShowS
shows (ZDD a -> (Graph Sig, Int)
forall a. ZDD a -> (Graph Sig, Int)
toGraph ZDD a
a)

instance Read (ZDD a) where
  readPrec :: ReadPrec (ZDD a)
readPrec = ReadPrec (ZDD a) -> ReadPrec (ZDD a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (ZDD a) -> ReadPrec (ZDD a))
-> ReadPrec (ZDD a) -> ReadPrec (ZDD a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (ZDD a) -> ReadPrec (ZDD a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (ZDD a) -> ReadPrec (ZDD a))
-> ReadPrec (ZDD a) -> ReadPrec (ZDD a)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"fromGraph" <- ReadPrec Lexeme
lexP
    (Graph Sig, Int)
gv <- ReadPrec (Graph Sig, Int)
forall a. Read a => ReadPrec a
readPrec
    ZDD a -> ReadPrec (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Graph Sig, Int) -> ZDD a
forall a. HasCallStack => (Graph Sig, Int) -> ZDD a
fromGraph (Graph Sig, Int)
gv)

  readListPrec :: ReadPrec [ZDD a]
readListPrec = ReadPrec [ZDD a]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance ItemOrder a => Exts.IsList (ZDD a) where
  type Item (ZDD a) = IntSet

  fromList :: [Item (ZDD a)] -> ZDD a
fromList = [[Int]] -> ZDD a
forall a. ItemOrder a => [[Int]] -> ZDD a
fromListOfSortedList ([[Int]] -> ZDD a) -> ([IntSet] -> [[Int]]) -> [IntSet] -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> [Int]) -> [IntSet] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map IntSet -> [Int]
f
    where
      f :: IntSet -> [Int]
      f :: IntSet -> [Int]
f = (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList

  toList :: ZDD a -> [Item (ZDD a)]
toList = ZDD a -> [Item (ZDD a)]
forall a. ZDD a -> [IntSet]
toListOfIntSets

-- ------------------------------------------------------------------------

data ZDDCase2 a
  = ZDDCase2LT Int (ZDD a) (ZDD a)
  | ZDDCase2GT Int (ZDD a) (ZDD a)
  | ZDDCase2EQ Int (ZDD a) (ZDD a) (ZDD a) (ZDD a)
  | ZDDCase2EQ2 Bool Bool

zddCase2 :: forall a. ItemOrder a => Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 :: Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 Proxy a
_ (Branch Int
ptop ZDD a
p0 ZDD a
p1) (Branch Int
qtop ZDD a
q0 ZDD a
q1) =
  case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
ptop Int
qtop of
    Ordering
LT -> Int -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. Int -> ZDD a -> ZDD a -> ZDDCase2 a
ZDDCase2LT Int
ptop ZDD a
p0 ZDD a
p1
    Ordering
GT -> Int -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. Int -> ZDD a -> ZDD a -> ZDDCase2 a
ZDDCase2GT Int
qtop ZDD a
q0 ZDD a
q1
    Ordering
EQ -> Int -> ZDD a -> ZDD a -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. Int -> ZDD a -> ZDD a -> ZDD a -> ZDD a -> ZDDCase2 a
ZDDCase2EQ Int
ptop ZDD a
p0 ZDD a
p1 ZDD a
q0 ZDD a
q1
zddCase2 Proxy a
_ (Branch Int
ptop ZDD a
p0 ZDD a
p1) ZDD a
_ = Int -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. Int -> ZDD a -> ZDD a -> ZDDCase2 a
ZDDCase2LT Int
ptop ZDD a
p0 ZDD a
p1
zddCase2 Proxy a
_ ZDD a
_ (Branch Int
qtop ZDD a
q0 ZDD a
q1) = Int -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. Int -> ZDD a -> ZDD a -> ZDDCase2 a
ZDDCase2GT Int
qtop ZDD a
q0 ZDD a
q1
zddCase2 Proxy a
_ ZDD a
Base ZDD a
Base = Bool -> Bool -> ZDDCase2 a
forall a. Bool -> Bool -> ZDDCase2 a
ZDDCase2EQ2 Bool
True Bool
True
zddCase2 Proxy a
_ ZDD a
Base ZDD a
Empty = Bool -> Bool -> ZDDCase2 a
forall a. Bool -> Bool -> ZDDCase2 a
ZDDCase2EQ2 Bool
True Bool
False
zddCase2 Proxy a
_ ZDD a
Empty ZDD a
Base = Bool -> Bool -> ZDDCase2 a
forall a. Bool -> Bool -> ZDDCase2 a
ZDDCase2EQ2 Bool
False Bool
True
zddCase2 Proxy a
_ ZDD a
Empty ZDD a
Empty = Bool -> Bool -> ZDDCase2 a
forall a. Bool -> Bool -> ZDDCase2 a
ZDDCase2EQ2 Bool
False Bool
False

-- | The empty family (∅).
--
-- >>> toSetOfIntSets (empty :: ZDD AscOrder)
-- fromList []
empty :: ZDD a
empty :: ZDD a
empty = ZDD a
forall a. ZDD a
Empty

-- | The family containing only the empty set ({∅}).
--
-- >>> toSetOfIntSets (base :: ZDD AscOrder)
-- fromList [fromList []]
base :: ZDD a
base :: ZDD a
base = ZDD a
forall a. ZDD a
Base

-- | Create a ZDD that contains only a given set.
--
-- >>> toSetOfIntSets (singleton (IntSet.fromList [1,2,3]) :: ZDD AscOrder)
-- fromList [fromList [1,2,3]]
singleton :: forall a. ItemOrder a => IntSet -> ZDD a
singleton :: IntSet -> ZDD a
singleton IntSet
xs = IntSet -> ZDD a -> ZDD a
forall a. ItemOrder a => IntSet -> ZDD a -> ZDD a
insert IntSet
xs ZDD a
forall a. ZDD a
empty

-- | Set of all subsets, i.e. powerset
subsets :: forall a. ItemOrder a => IntSet -> ZDD a
subsets :: IntSet -> ZDD a
subsets = (ZDD a -> Int -> ZDD a) -> ZDD a -> [Int] -> ZDD a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ZDD a -> Int -> ZDD a
forall a. ZDD a -> Int -> ZDD a
f ZDD a
forall a. ZDD a
Base ([Int] -> ZDD a) -> (IntSet -> [Int]) -> IntSet -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))) ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList
  where
    f :: ZDD a -> Int -> ZDD a
f ZDD a
zdd Int
x = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
x ZDD a
zdd ZDD a
zdd

-- | Set of all k-combination of a set
combinations :: forall a. (ItemOrder a, HasCallStack) => IntSet -> Int -> ZDD a
combinations :: IntSet -> Int -> ZDD a
combinations IntSet
xs Int
k
  | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> ZDD a
forall a. HasCallStack => String -> a
error String
"Data.DecisionDiagram.ZDD.combinations: negative size"
  | Bool
otherwise = ((Int, Int) -> Sig (Int, Int)) -> (Int, Int) -> ZDD a
forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd (Int, Int) -> Sig (Int, Int)
f (Int
0, Int
k)
  where
    table :: Vector Int
table = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IntSet.toList IntSet
xs
    n :: Int
n = Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
table

    f :: (Int, Int) -> Sig (Int, Int)
    f :: (Int, Int) -> Sig (Int, Int)
f (!Int
_, !Int
0) = Bool -> Sig (Int, Int)
forall a. Bool -> Sig a
SLeaf Bool
True
    f (!Int
i, !Int
k')
      | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = Bool -> Sig (Int, Int)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Bool
otherwise  = Int -> (Int, Int) -> (Int, Int) -> Sig (Int, Int)
forall a. Int -> a -> a -> Sig a
SBranch (Vector Int
table Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.! Int
i) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
k') (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
k'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- | Set of all subsets whose sum of weights is at least k.
subsetsAtLeast :: forall a w. (ItemOrder a, Real w) => IntMap w -> w -> ZDD a
subsetsAtLeast :: IntMap w -> w -> ZDD a
subsetsAtLeast IntMap w
xs w
k0 = ((Int, w) -> Sig (Int, w)) -> (Int, w) -> ZDD a
forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd (Int, w) -> Sig (Int, w)
f (Int
0, w
k0)
  where
    xs' :: V.Vector (Int, w)
    xs' :: Vector (Int, w)
xs' = [(Int, w)] -> Vector (Int, w)
forall a. [a] -> Vector a
V.fromList ([(Int, w)] -> Vector (Int, w)) -> [(Int, w)] -> Vector (Int, w)
forall a b. (a -> b) -> a -> b
$ ((Int, w) -> (Int, w) -> Ordering) -> [(Int, w)] -> [(Int, w)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Int -> Int -> Ordering)
-> ((Int, w) -> Int) -> (Int, w) -> (Int, w) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, w) -> Int
forall a b. (a, b) -> a
fst) ([(Int, w)] -> [(Int, w)]) -> [(Int, w)] -> [(Int, w)]
forall a b. (a -> b) -> a -> b
$ IntMap w -> [(Int, w)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap w
xs
    ys :: V.Vector (w, w)
    ys :: Vector (w, w)
ys = ((Int, w) -> (w, w) -> (w, w))
-> (w, w) -> Vector (Int, w) -> Vector (w, w)
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr (\(Int
_, w
w) (w
lb,w
ub) -> if w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0 then (w
lb, w
ubw -> w -> w
forall a. Num a => a -> a -> a
+w
w) else (w
lbw -> w -> w
forall a. Num a => a -> a -> a
+w
w, w
ub)) (w
0,w
0) Vector (Int, w)
xs'

    f :: (Int, w) -> Sig (Int, w)
    f :: (Int, w) -> Sig (Int, w)
f (!Int
i, !w
k)
      | Bool -> Bool
not (w
k w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
ub) = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Int, w) -> Int
forall a. Vector a -> Int
V.length Vector (Int, w)
xs' Bool -> Bool -> Bool
&& w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
k = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
True
      | w
lb w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
k = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
lb) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
lb) -- all remaining variables are don't-care
      | Bool
otherwise = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
kw -> w -> w
forall a. Num a => a -> a -> a
-w
w)
      where
        (w
lb,w
ub) = Vector (w, w)
ys Vector (w, w) -> Int -> (w, w)
forall a. Vector a -> Int -> a
V.! Int
i
        (Int
x, w
w) = Vector (Int, w)
xs' Vector (Int, w) -> Int -> (Int, w)
forall a. Vector a -> Int -> a
V.! Int
i

-- | Set of all subsets whose sum of weights is at most k.
subsetsAtMost :: forall a w. (ItemOrder a, Real w) => IntMap w -> w -> ZDD a
subsetsAtMost :: IntMap w -> w -> ZDD a
subsetsAtMost IntMap w
xs w
k0 = ((Int, w) -> Sig (Int, w)) -> (Int, w) -> ZDD a
forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd (Int, w) -> Sig (Int, w)
f (Int
0, w
k0)
  where
    xs' :: V.Vector (Int, w)
    xs' :: Vector (Int, w)
xs' = [(Int, w)] -> Vector (Int, w)
forall a. [a] -> Vector a
V.fromList ([(Int, w)] -> Vector (Int, w)) -> [(Int, w)] -> Vector (Int, w)
forall a b. (a -> b) -> a -> b
$ ((Int, w) -> (Int, w) -> Ordering) -> [(Int, w)] -> [(Int, w)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Int -> Int -> Ordering)
-> ((Int, w) -> Int) -> (Int, w) -> (Int, w) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, w) -> Int
forall a b. (a, b) -> a
fst) ([(Int, w)] -> [(Int, w)]) -> [(Int, w)] -> [(Int, w)]
forall a b. (a -> b) -> a -> b
$ IntMap w -> [(Int, w)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap w
xs
    ys :: V.Vector (w, w)
    ys :: Vector (w, w)
ys = ((Int, w) -> (w, w) -> (w, w))
-> (w, w) -> Vector (Int, w) -> Vector (w, w)
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr (\(Int
_, w
w) (w
lb,w
ub) -> if w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0 then (w
lb, w
ubw -> w -> w
forall a. Num a => a -> a -> a
+w
w) else (w
lbw -> w -> w
forall a. Num a => a -> a -> a
+w
w, w
ub)) (w
0,w
0) Vector (Int, w)
xs'

    f :: (Int, w) -> Sig (Int, w)
    f :: (Int, w) -> Sig (Int, w)
f (!Int
i, !w
k)
      | Bool -> Bool
not (w
lb w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
k) = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Int, w) -> Int
forall a. Vector a -> Int
V.length Vector (Int, w)
xs' Bool -> Bool -> Bool
&& w
0 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
k = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
True
      | w
ub w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
k = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
ub) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
ub) -- all remaining variables are don't-care
      | Bool
otherwise = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
kw -> w -> w
forall a. Num a => a -> a -> a
-w
w)
      where
        (w
lb,w
ub) = Vector (w, w)
ys Vector (w, w) -> Int -> (w, w)
forall a. Vector a -> Int -> a
V.! Int
i
        (Int
x, w
w) = Vector (Int, w)
xs' Vector (Int, w) -> Int -> (Int, w)
forall a. Vector a -> Int -> a
V.! Int
i

-- | Set of all subsets whose sum of weights is exactly k.
--
-- Note that 'combinations' is a special case where all weights are 1.
--
-- If weight type is 'Integral', 'subsetsExactlyIntegral' is more efficient.
subsetsExactly :: forall a w. (ItemOrder a, Real w) => IntMap w -> w -> ZDD a
subsetsExactly :: IntMap w -> w -> ZDD a
subsetsExactly IntMap w
xs w
k0 = ((Int, w) -> Sig (Int, w)) -> (Int, w) -> ZDD a
forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd (Int, w) -> Sig (Int, w)
f (Int
0, w
k0)
  where
    xs' :: V.Vector (Int, w)
    xs' :: Vector (Int, w)
xs' = [(Int, w)] -> Vector (Int, w)
forall a. [a] -> Vector a
V.fromList ([(Int, w)] -> Vector (Int, w)) -> [(Int, w)] -> Vector (Int, w)
forall a b. (a -> b) -> a -> b
$ ((Int, w) -> (Int, w) -> Ordering) -> [(Int, w)] -> [(Int, w)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Int -> Int -> Ordering)
-> ((Int, w) -> Int) -> (Int, w) -> (Int, w) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, w) -> Int
forall a b. (a, b) -> a
fst) ([(Int, w)] -> [(Int, w)]) -> [(Int, w)] -> [(Int, w)]
forall a b. (a -> b) -> a -> b
$ IntMap w -> [(Int, w)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap w
xs
    ys :: V.Vector (w, w)
    ys :: Vector (w, w)
ys = ((Int, w) -> (w, w) -> (w, w))
-> (w, w) -> Vector (Int, w) -> Vector (w, w)
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr (\(Int
_, w
w) (w
lb,w
ub) -> if w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0 then (w
lb, w
ubw -> w -> w
forall a. Num a => a -> a -> a
+w
w) else (w
lbw -> w -> w
forall a. Num a => a -> a -> a
+w
w, w
ub)) (w
0,w
0) Vector (Int, w)
xs'

    f :: (Int, w) -> Sig (Int, w)
    f :: (Int, w) -> Sig (Int, w)
f (!Int
i, !w
k)
      | Bool -> Bool
not (w
lb w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
k Bool -> Bool -> Bool
&& w
k w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
ub) = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Int, w) -> Int
forall a. Vector a -> Int
V.length Vector (Int, w)
xs' Bool -> Bool -> Bool
&& w
0 w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
k = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
True
      | Bool
otherwise = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
kw -> w -> w
forall a. Num a => a -> a -> a
-w
w)
      where
        (w
lb,w
ub) = Vector (w, w)
ys Vector (w, w) -> Int -> (w, w)
forall a. Vector a -> Int -> a
V.! Int
i
        (Int
x, w
w) = Vector (Int, w)
xs' Vector (Int, w) -> Int -> (Int, w)
forall a. Vector a -> Int -> a
V.! Int
i

-- | Similar to 'subsetsExactly' but more efficient.
subsetsExactlyIntegral :: forall a w. (ItemOrder a, Real w, Integral w) => IntMap w -> w -> ZDD a
subsetsExactlyIntegral :: IntMap w -> w -> ZDD a
subsetsExactlyIntegral IntMap w
xs w
k0 = ((Int, w) -> Sig (Int, w)) -> (Int, w) -> ZDD a
forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd (Int, w) -> Sig (Int, w)
f (Int
0, w
k0)
  where
    xs' :: V.Vector (Int, w)
    xs' :: Vector (Int, w)
xs' = [(Int, w)] -> Vector (Int, w)
forall a. [a] -> Vector a
V.fromList ([(Int, w)] -> Vector (Int, w)) -> [(Int, w)] -> Vector (Int, w)
forall a b. (a -> b) -> a -> b
$ ((Int, w) -> (Int, w) -> Ordering) -> [(Int, w)] -> [(Int, w)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) (Int -> Int -> Ordering)
-> ((Int, w) -> Int) -> (Int, w) -> (Int, w) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, w) -> Int
forall a b. (a, b) -> a
fst) ([(Int, w)] -> [(Int, w)]) -> [(Int, w)] -> [(Int, w)]
forall a b. (a -> b) -> a -> b
$ IntMap w -> [(Int, w)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap w
xs
    ys :: V.Vector (w, w)
    ys :: Vector (w, w)
ys = ((Int, w) -> (w, w) -> (w, w))
-> (w, w) -> Vector (Int, w) -> Vector (w, w)
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr (\(Int
_, w
w) (w
lb,w
ub) -> if w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
0 then (w
lb, w
ubw -> w -> w
forall a. Num a => a -> a -> a
+w
w) else (w
lbw -> w -> w
forall a. Num a => a -> a -> a
+w
w, w
ub)) (w
0,w
0) Vector (Int, w)
xs'
    ds :: V.Vector w
    ds :: Vector w
ds = (w -> w -> w) -> Vector w -> Vector w
forall a. (a -> a -> a) -> Vector a -> Vector a
V.scanr1 (\w
w w
d -> if w
w w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0 then w -> w -> w
forall a. Integral a => a -> a -> a
gcd w
w w
d else w
d) (((Int, w) -> w) -> Vector (Int, w) -> Vector w
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Int, w) -> w
forall a b. (a, b) -> b
snd Vector (Int, w)
xs')

    f :: (Int, w) -> Sig (Int, w)
    f :: (Int, w) -> Sig (Int, w)
f (!Int
i, !w
k)
      | Bool -> Bool
not (w
lb w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
k Bool -> Bool -> Bool
&& w
k w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
ub) = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Int, w) -> Int
forall a. Vector a -> Int
V.length Vector (Int, w)
xs' Bool -> Bool -> Bool
&& w
0 w -> w -> Bool
forall a. Eq a => a -> a -> Bool
== w
k = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
True
      | w
d w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0 Bool -> Bool -> Bool
&& w
k w -> w -> w
forall a. Integral a => a -> a -> a
`mod` w
d w -> w -> Bool
forall a. Eq a => a -> a -> Bool
/= w
0 = Bool -> Sig (Int, w)
forall a. Bool -> Sig a
SLeaf Bool
False
      | Bool
otherwise = Int -> (Int, w) -> (Int, w) -> Sig (Int, w)
forall a. Int -> a -> a -> Sig a
SBranch Int
x (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, w
kw -> w -> w
forall a. Num a => a -> a -> a
-w
w)
      where
        (w
lb,w
ub) = Vector (w, w)
ys Vector (w, w) -> Int -> (w, w)
forall a. Vector a -> Int -> a
V.! Int
i
        (Int
x, w
w) = Vector (Int, w)
xs' Vector (Int, w) -> Int -> (Int, w)
forall a. Vector a -> Int -> a
V.! Int
i
        d :: w
d = Vector w
ds Vector w -> Int -> w
forall a. Vector a -> Int -> a
V.! Int
i

-- | Select subsets that contain a particular element and then remove the element from them
--
-- >>> toSetOfIntSets $ subset1 2 (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [2,4]]) :: ZDD AscOrder)
-- fromList [fromList [1,3],fromList [4]]
subset1 :: forall a. ItemOrder a => Int -> ZDD a -> ZDD a
subset1 :: Int -> ZDD a -> ZDD a
subset1 Int
var ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
top Int
var of
              Ordering
GT -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
              Ordering
EQ -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p1
              Ordering
LT -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
f ZDD a
p1)
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | Subsets that does not contain a particular element
--
-- >>> toSetOfIntSets $ subset0 2 (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [2,4], [3,4]]) :: ZDD AscOrder)
-- fromList [fromList [1,3],fromList [3,4]]
subset0 :: forall a. ItemOrder a => Int -> ZDD a -> ZDD a
subset0 :: Int -> ZDD a -> ZDD a
subset0 Int
var ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f p :: ZDD a
p@ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
top Int
var of
              Ordering
GT -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
              Ordering
EQ -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p0
              Ordering
LT -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
f ZDD a
p1)
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | Insert a set into the ZDD.
--
-- >>> toSetOfIntSets (insert (IntSet.fromList [1,2,3]) (fromListOfIntSets (map IntSet.fromList [[1,3], [2,4]])) :: ZDD AscOrder)
-- fromList [fromList [1,2,3],fromList [1,3],fromList [2,4]]
insert :: forall a. ItemOrder a => IntSet -> ZDD a -> ZDD a
insert :: IntSet -> ZDD a -> ZDD a
insert IntSet
xs = [Int] -> ZDD a -> ZDD a
f ((Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) (IntSet -> [Int]
IntSet.toList IntSet
xs))
  where
    f :: [Int] -> ZDD a -> ZDD a
f [] (Leaf Bool
_) = ZDD a
forall a. ZDD a
Base
    f [] (Branch Int
top ZDD a
p0 ZDD a
p1) = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ([Int] -> ZDD a -> ZDD a
f [] ZDD a
p0) ZDD a
p1
    f (Int
y : [Int]
ys) ZDD a
Empty = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
y ZDD a
forall a. ZDD a
Empty ([Int] -> ZDD a -> ZDD a
f [Int]
ys ZDD a
forall a. ZDD a
Empty)
    f (Int
y : [Int]
ys) ZDD a
Base = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
y ZDD a
forall a. ZDD a
Base ([Int] -> ZDD a -> ZDD a
f [Int]
ys ZDD a
forall a. ZDD a
Empty)
    f yys :: [Int]
yys@(Int
y : [Int]
ys) p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) =
      case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
y Int
top of
        Ordering
LT -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
y ZDD a
p ([Int] -> ZDD a -> ZDD a
f [Int]
ys ZDD a
forall a. ZDD a
Empty)
        Ordering
GT -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ([Int] -> ZDD a -> ZDD a
f [Int]
yys ZDD a
p0) ZDD a
p1
        Ordering
EQ -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ZDD a
p0 ([Int] -> ZDD a -> ZDD a
f [Int]
ys ZDD a
p1)

-- | Delete a set from the ZDD.
--
-- >>> toSetOfIntSets (delete (IntSet.fromList [1,3]) (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [2,4]])) :: ZDD AscOrder)
-- fromList [fromList [1,2,3],fromList [2,4]]
delete :: forall a. ItemOrder a => IntSet -> ZDD a -> ZDD a
delete :: IntSet -> ZDD a -> ZDD a
delete IntSet
xs = [Int] -> ZDD a -> ZDD a
f ((Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) (IntSet -> [Int]
IntSet.toList IntSet
xs))
  where
    f :: [Int] -> ZDD a -> ZDD a
f [] (Leaf Bool
_) = ZDD a
forall a. ZDD a
Empty
    f [] (Branch Int
top ZDD a
p0 ZDD a
p1) = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ([Int] -> ZDD a -> ZDD a
f [] ZDD a
p0) ZDD a
p1
    f (Int
_ : [Int]
_) l :: ZDD a
l@(Leaf Bool
_) = ZDD a
l
    f yys :: [Int]
yys@(Int
y : [Int]
ys) p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) =
      case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
y Int
top of
        Ordering
LT -> ZDD a
p
        Ordering
GT -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ([Int] -> ZDD a -> ZDD a
f [Int]
yys ZDD a
p0) ZDD a
p1
        Ordering
EQ -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ZDD a
p0 ([Int] -> ZDD a -> ZDD a
f [Int]
ys ZDD a
p1)

-- | Insert an item into each element set of ZDD.
--
-- >>> toSetOfIntSets (mapInsert 2 (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [1,4]])) :: ZDD AscOrder)
-- fromList [fromList [1,2,3],fromList [1,2,4]]
mapInsert :: forall a. ItemOrder a => Int -> ZDD a -> ZDD a
mapInsert :: Int -> ZDD a -> ZDD a
mapInsert Int
var ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
unionOp <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f p :: ZDD a
p@ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
var ZDD a
forall a. ZDD a
Empty ZDD a
p)
      f ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
top Int
var of
              Ordering
GT -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
var ZDD a
forall a. ZDD a
Empty ZDD a
p)
              Ordering
LT -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
f ZDD a
p1)
              Ordering
EQ -> (ZDD a -> ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ZDD a
forall a. ZDD a
Empty) (ZDD a -> ZDD a -> ST s (ZDD a)
unionOp ZDD a
p0 ZDD a
p1)
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | Delete an item from each element set of ZDD.
--
-- >>> toSetOfIntSets (mapDelete 2 (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [1,2,4]])) :: ZDD AscOrder)
-- fromList [fromList [1,3],fromList [1,4]]
mapDelete :: forall a. ItemOrder a => Int -> ZDD a -> ZDD a
mapDelete :: Int -> ZDD a -> ZDD a
mapDelete Int
var ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
unionOp <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f l :: ZDD a
l@(Leaf Bool
_) = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
l
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
top Int
var of
              Ordering
GT -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
              Ordering
LT -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
f ZDD a
p1)
              Ordering
EQ -> ZDD a -> ZDD a -> ST s (ZDD a)
unionOp ZDD a
p0 ZDD a
p1
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | @change x p@ returns {if x∈s then s∖{x} else s∪{x} | s∈P}
--
-- >>> toSetOfIntSets (change 2 (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [1,2,4]])) :: ZDD AscOrder)
-- fromList [fromList [1,2,3],fromList [1,3],fromList [1,4]]
change :: forall a. ItemOrder a => Int -> ZDD a -> ZDD a
change :: Int -> ZDD a -> ZDD a
change Int
var ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f p :: ZDD a
p@ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
var ZDD a
forall a. ZDD a
Empty ZDD a
p)
      f ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
top Int
var of
              Ordering
GT -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
var ZDD a
forall a. ZDD a
Empty ZDD a
p)
              Ordering
EQ -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
var ZDD a
p1 ZDD a
p0)
              Ordering
LT -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
f ZDD a
p1)
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | Union of two family of sets.
union :: forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
union :: ZDD a -> ZDD a -> ZDD a
union ZDD a
zdd1 ZDD a
zdd2 = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
op <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp
  ZDD a -> ZDD a -> ST s (ZDD a)
op ZDD a
zdd1 ZDD a
zdd2

mkUnionOp :: forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp :: ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp = do
  HashTable s (ZDD a, ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a, ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
Empty ZDD a
q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
q
      f ZDD a
p ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
p ZDD a
q | ZDD a
p ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
== ZDD a
q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
p ZDD a
q = do
        let key :: (ZDD a, ZDD a)
key = if ZDD a -> Int
forall a. ZDD a -> Int
nodeId ZDD a
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ZDD a -> Int
forall a. ZDD a -> Int
nodeId ZDD a
q then (ZDD a
p, ZDD a
q) else (ZDD a
q, ZDD a
p)
        Maybe (ZDD a)
m <- HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a, ZDD a)
key
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. ItemOrder a => Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ZDD a
p ZDD a
q of
              ZDDCase2LT Int
ptop ZDD a
p0 ZDD a
p1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
ptop) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q) (ZDD a -> ST s (ZDD a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZDD a
p1)
              ZDDCase2GT Int
qtop ZDD a
q0 ZDD a
q1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
qtop) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p ZDD a
q0) (ZDD a -> ST s (ZDD a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZDD a
q1)
              ZDDCase2EQ Int
top ZDD a
p0 ZDD a
p1 ZDD a
q0 ZDD a
q1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q0) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q1)
              ZDDCase2EQ2 Bool
_ Bool
_ -> String -> ST s (ZDD a)
forall a. HasCallStack => String -> a
error String
"union: should not happen"
            HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a, ZDD a)
key ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  (ZDD a -> ZDD a -> ST s (ZDD a))
-> ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a -> ZDD a -> ST s (ZDD a)
f

-- | Unions of a list of ZDDs.
unions :: forall f a. (Foldable f, ItemOrder a) => f (ZDD a) -> ZDD a
unions :: f (ZDD a) -> ZDD a
unions f (ZDD a)
xs = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
op <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp
  (ZDD a -> ZDD a -> ST s (ZDD a))
-> ZDD a -> f (ZDD a) -> ST s (ZDD a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ZDD a -> ZDD a -> ST s (ZDD a)
op ZDD a
forall a. ZDD a
empty f (ZDD a)
xs

-- | Intersection of two family of sets.
intersection :: forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
intersection :: ZDD a -> ZDD a -> ZDD a
intersection ZDD a
zdd1 ZDD a
zdd2 = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
op <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkIntersectionOp
  ZDD a -> ZDD a -> ST s (ZDD a)
op ZDD a
zdd1 ZDD a
zdd2

mkIntersectionOp :: forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkIntersectionOp :: ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkIntersectionOp = do
  HashTable s (ZDD a, ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a, ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
Empty ZDD a
_q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
_p ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
p ZDD a
q | ZDD a
p ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
== ZDD a
q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
p ZDD a
q = do
        let key :: (ZDD a, ZDD a)
key = if ZDD a -> Int
forall a. ZDD a -> Int
nodeId ZDD a
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ZDD a -> Int
forall a. ZDD a -> Int
nodeId ZDD a
q then (ZDD a
p, ZDD a
q) else (ZDD a
q, ZDD a
p)
        Maybe (ZDD a)
m <- HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a, ZDD a)
key
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. ItemOrder a => Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ZDD a
p ZDD a
q of
              ZDDCase2LT Int
_ptop ZDD a
p0 ZDD a
_p1 -> ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q
              ZDDCase2GT Int
_qtop ZDD a
q0 ZDD a
_q1 -> ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p ZDD a
q0
              ZDDCase2EQ Int
top ZDD a
p0 ZDD a
p1 ZDD a
q0 ZDD a
q1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q0) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q1)
              ZDDCase2EQ2 Bool
_ Bool
_ -> String -> ST s (ZDD a)
forall a. HasCallStack => String -> a
error String
"intersection: should not happen"
            HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a, ZDD a)
key ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  (ZDD a -> ZDD a -> ST s (ZDD a))
-> ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a -> ZDD a -> ST s (ZDD a)
f

-- | Difference of two family of sets.
difference :: forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
difference :: ZDD a -> ZDD a -> ZDD a
difference ZDD a
zdd1 ZDD a
zdd2 = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
op <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkDifferenceOp
  ZDD a -> ZDD a -> ST s (ZDD a)
op ZDD a
zdd1 ZDD a
zdd2

mkDifferenceOp :: forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkDifferenceOp :: ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkDifferenceOp = do
  HashTable s (ZDD a, ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a, ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
Empty ZDD a
_ = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
p ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
p ZDD a
q | ZDD a
p ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
== ZDD a
q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
p ZDD a
q = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a
p, ZDD a
q)
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. ItemOrder a => Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ZDD a
p ZDD a
q of
              ZDDCase2LT Int
ptop ZDD a
p0 ZDD a
p1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
ptop) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q) (ZDD a -> ST s (ZDD a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZDD a
p1)
              ZDDCase2GT Int
_qtop ZDD a
q0 ZDD a
_q1 -> ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p ZDD a
q0
              ZDDCase2EQ Int
top ZDD a
p0 ZDD a
p1 ZDD a
q0 ZDD a
q1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q0) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q1)
              ZDDCase2EQ2 Bool
_ Bool
_ -> String -> ST s (ZDD a)
forall a. HasCallStack => String -> a
error String
"difference: should not happen"
            HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a
p, ZDD a
q) ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  (ZDD a -> ZDD a -> ST s (ZDD a))
-> ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a -> ZDD a -> ST s (ZDD a)
f

-- | See 'difference'
(\\) :: forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
ZDD a
m1 \\ :: ZDD a -> ZDD a -> ZDD a
\\ ZDD a
m2 = ZDD a -> ZDD a -> ZDD a
forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
difference ZDD a
m1 ZDD a
m2

-- | Given a family P and Q, it computes {S∈P | ∀X∈Q. X⊈S}
--
-- Sometimes it is denoted as /P ↘ Q/.
--
-- >>> toSetOfIntSets (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [3,4]]) `nonSuperset` singleton (IntSet.fromList [1,3]) :: ZDD AscOrder)
-- fromList [fromList [3,4]]
nonSuperset :: forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
nonSuperset :: ZDD a -> ZDD a -> ZDD a
nonSuperset ZDD a
zdd1 ZDD a
zdd2 = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
op <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkNonSupersetOp
  ZDD a -> ZDD a -> ST s (ZDD a)
op ZDD a
zdd1 ZDD a
zdd2

mkNonSupersetOp :: forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkNonSupersetOp :: ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkNonSupersetOp = do
  ZDD a -> ZDD a -> ST s (ZDD a)
intersectionOp <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkIntersectionOp
  HashTable s (ZDD a, ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a, ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
Empty ZDD a
_ = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
_ ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
p ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
p
      f ZDD a
p ZDD a
q | ZDD a
p ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
== ZDD a
q = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f ZDD a
p ZDD a
q = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a
p, ZDD a
q)
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ret <- case Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
forall a. ItemOrder a => Proxy a -> ZDD a -> ZDD a -> ZDDCase2 a
zddCase2 (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ZDD a
p ZDD a
q of
              ZDDCase2LT Int
ptop ZDD a
p0 ZDD a
p1 -> (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
ptop) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q)
              ZDDCase2GT Int
_qtop ZDD a
q0 ZDD a
_q1 -> ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p ZDD a
q0
              ZDDCase2EQ Int
top ZDD a
p0 ZDD a
p1 ZDD a
q0 ZDD a
q1 -> do
                ZDD a
r0 <- ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q0
                ZDD a
r1 <- ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p1 ZDD a
q1
                (ZDD a -> ZDD a -> ZDD a)
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top) (ZDD a -> ZDD a -> ST s (ZDD a)
f ZDD a
p0 ZDD a
q0) (ZDD a -> ZDD a -> ST s (ZDD a)
intersectionOp ZDD a
r0 ZDD a
r1)
              ZDDCase2EQ2 Bool
_ Bool
_ -> String -> ST s (ZDD a)
forall a. HasCallStack => String -> a
error String
"nonSuperset: should not happen"
            HashTable s (ZDD a, ZDD a) (ZDD a)
-> (ZDD a, ZDD a) -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a, ZDD a) (ZDD a)
h (ZDD a
p, ZDD a
q) ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  (ZDD a -> ZDD a -> ST s (ZDD a))
-> ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a -> ZDD a -> ST s (ZDD a)
f

minimalHittingSetsKnuth' :: forall a. ItemOrder a => Bool -> ZDD a -> ZDD a
minimalHittingSetsKnuth' :: Bool -> ZDD a -> ZDD a
minimalHittingSetsKnuth' Bool
imai ZDD a
zdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
unionOp <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkUnionOp
  ZDD a -> ZDD a -> ST s (ZDD a)
diffOp <- if Bool
imai then ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkDifferenceOp else ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkNonSupersetOp
  HashTable s (ZDD a) (ZDD a)
h <- Int -> ST s (HashTable s (ZDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: ZDD a -> ST s (ZDD a)
f ZDD a
Empty = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Base
      f ZDD a
Base = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
forall a. ZDD a
Empty
      f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) = do
        Maybe (ZDD a)
m <- HashTable s (ZDD a) (ZDD a) -> ZDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (ZDD a)
h ZDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
r0 <- ZDD a -> ST s (ZDD a)
f (ZDD a -> ST s (ZDD a)) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ZDD a -> ZDD a -> ST s (ZDD a)
unionOp ZDD a
p0 ZDD a
p1
            ZDD a
r1 <- ST s (ST s (ZDD a)) -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ST s (ST s (ZDD a)) -> ST s (ZDD a))
-> ST s (ST s (ZDD a)) -> ST s (ZDD a)
forall a b. (a -> b) -> a -> b
$ (ZDD a -> ZDD a -> ST s (ZDD a))
-> ST s (ZDD a) -> ST s (ZDD a) -> ST s (ST s (ZDD a))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 ZDD a -> ZDD a -> ST s (ZDD a)
diffOp (ZDD a -> ST s (ZDD a)
f ZDD a
p0) (ZDD a -> ST s (ZDD a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZDD a
r0)
            let ret :: ZDD a
ret = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
top ZDD a
r0 ZDD a
r1
            HashTable s (ZDD a) (ZDD a) -> ZDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (ZDD a)
h ZDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  ZDD a -> ST s (ZDD a)
f ZDD a
zdd

-- | Minimal hitting sets.
--
-- D. E. Knuth, "The Art of Computer Programming, Volume 4A:
-- Combinatorial Algorithms, Part 1," Addison-Wesley Professional,
-- 2011.
minimalHittingSetsKnuth :: forall a. ItemOrder a => ZDD a -> ZDD a
minimalHittingSetsKnuth :: ZDD a -> ZDD a
minimalHittingSetsKnuth = Bool -> ZDD a -> ZDD a
forall a. ItemOrder a => Bool -> ZDD a -> ZDD a
minimalHittingSetsKnuth' Bool
False

-- | Minimal hitting sets.
--
-- T. Imai, "One-line hack of knuth's algorithm for minimal hitting set
-- computation with ZDDs," vol. 2015-AL-155, no. 15, Nov. 2015, pp. 1-3.
-- [Online]. Available: <http://id.nii.ac.jp/1001/00145799/>.
minimalHittingSetsImai :: forall a. ItemOrder a => ZDD a -> ZDD a
minimalHittingSetsImai :: ZDD a -> ZDD a
minimalHittingSetsImai = Bool -> ZDD a -> ZDD a
forall a. ItemOrder a => Bool -> ZDD a -> ZDD a
minimalHittingSetsKnuth' Bool
True

-- | Minimal hitting sets.
--
-- * T. Toda, “Hypergraph Transversal Computation with Binary Decision Diagrams,”
--   SEA 2013: Experimental Algorithms.
--   Available: <http://dx.doi.org/10.1007/978-3-642-38527-8_10>.
--
-- * HTC-BDD: Hypergraph Transversal Computation with Binary Decision Diagrams
--   <https://www.disc.lab.uec.ac.jp/toda/htcbdd.html>
minimalHittingSetsToda :: forall a. ItemOrder a => ZDD a -> ZDD a
minimalHittingSetsToda :: ZDD a -> ZDD a
minimalHittingSetsToda = BDD a -> ZDD a
forall a. ItemOrder a => BDD a -> ZDD a
minimal (BDD a -> ZDD a) -> (ZDD a -> BDD a) -> ZDD a -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZDD a -> BDD a
forall a. ItemOrder a => ZDD a -> BDD a
hittingSetsBDD

hittingSetsBDD :: forall a. ItemOrder a => ZDD a -> BDD.BDD a
hittingSetsBDD :: ZDD a -> BDD a
hittingSetsBDD = (Int -> BDD a -> BDD a -> BDD a)
-> (Bool -> BDD a) -> ZDD a -> BDD a
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' (\Int
top BDD a
h0 BDD a
h1 -> BDD a
h0 BDD a -> BDD a -> BDD a
forall a. ItemOrder a => BDD a -> BDD a -> BDD a
BDD..&&. Int -> BDD a -> BDD a -> BDD a
forall a. Int -> BDD a -> BDD a -> BDD a
BDD.Branch Int
top BDD a
h1 BDD a
forall a. BDD a
BDD.true) (\Bool
b -> Bool -> BDD a
forall a. Bool -> BDD a
BDD.Leaf (Bool -> Bool
not Bool
b))

minimal :: forall a. ItemOrder a => BDD.BDD a -> ZDD a
minimal :: BDD a -> ZDD a
minimal BDD a
bdd = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  ZDD a -> ZDD a -> ST s (ZDD a)
diffOp <- ST s (ZDD a -> ZDD a -> ST s (ZDD a))
forall a s. ItemOrder a => ST s (ZDD a -> ZDD a -> ST s (ZDD a))
mkDifferenceOp
  HashTable s (BDD a) (ZDD a)
h <- Int -> ST s (HashTable s (BDD a) (ZDD a))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let f :: BDD a -> ST s (ZDD a)
f (BDD.Leaf Bool
b) = ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ZDD a
forall a. Bool -> ZDD a
Leaf Bool
b)
      f p :: BDD a
p@(BDD.Branch Int
x BDD a
lo BDD a
hi) = do
        Maybe (ZDD a)
m <- HashTable s (BDD a) (ZDD a) -> BDD a -> ST s (Maybe (ZDD a))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (BDD a) (ZDD a)
h BDD a
p
        case Maybe (ZDD a)
m of
          Just ZDD a
ret -> ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
          Maybe (ZDD a)
Nothing -> do
            ZDD a
ml <- BDD a -> ST s (ZDD a)
f BDD a
lo
            ZDD a
mh <- BDD a -> ST s (ZDD a)
f BDD a
hi
            ZDD a
ret <- (ZDD a -> ZDD a) -> ST s (ZDD a) -> ST s (ZDD a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
x ZDD a
ml) (ZDD a -> ZDD a -> ST s (ZDD a)
diffOp ZDD a
mh ZDD a
ml)
            HashTable s (BDD a) (ZDD a) -> BDD a -> ZDD a -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (BDD a) (ZDD a)
h BDD a
p ZDD a
ret
            ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return ZDD a
ret
  BDD a -> ST s (ZDD a)
f BDD a
bdd

-- | See 'minimalHittingSetsToda'.
--
-- >>> toSetOfIntSets (minimalHittingSets (fromListOfIntSets (map IntSet.fromList [[1], [2,3,5], [2,3,6], [2,4,5], [2,4,6]]) :: ZDD AscOrder))
-- fromList [fromList [1,2],fromList [1,3,4],fromList [1,5,6]]
minimalHittingSets :: forall a. ItemOrder a => ZDD a -> ZDD a
minimalHittingSets :: ZDD a -> ZDD a
minimalHittingSets = ZDD a -> ZDD a
forall a. ItemOrder a => ZDD a -> ZDD a
minimalHittingSetsToda

-- | Is the set a member of the family?
member :: forall a. (ItemOrder a) => IntSet -> ZDD a -> Bool
member :: IntSet -> ZDD a -> Bool
member IntSet
xs = [Int] -> ZDD a -> Bool
forall a. ItemOrder a => [Int] -> ZDD a -> Bool
member' [Int]
xs'
  where
    xs' :: [Int]
xs' = (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IntSet.toList IntSet
xs

member' :: forall a. (ItemOrder a) => [Int] -> ZDD a -> Bool
member' :: [Int] -> ZDD a -> Bool
member' [] ZDD a
Base = Bool
True
member' [] (Branch Int
_ ZDD a
p0 ZDD a
_) = [Int] -> ZDD a -> Bool
forall a. ItemOrder a => [Int] -> ZDD a -> Bool
member' [] ZDD a
p0
member' yys :: [Int]
yys@(Int
y:[Int]
ys) (Branch Int
top ZDD a
p0 ZDD a
p1) =
  case Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Int
y Int
top of
    Ordering
EQ -> [Int] -> ZDD a -> Bool
forall a. ItemOrder a => [Int] -> ZDD a -> Bool
member' [Int]
ys ZDD a
p1
    Ordering
GT -> [Int] -> ZDD a -> Bool
forall a. ItemOrder a => [Int] -> ZDD a -> Bool
member' [Int]
yys ZDD a
p0
    Ordering
LT -> Bool
False
member' [Int]
_ ZDD a
_ = Bool
False

-- | Is the set not in the family?
notMember :: forall a. (ItemOrder a) => IntSet -> ZDD a -> Bool
notMember :: IntSet -> ZDD a -> Bool
notMember IntSet
xs = Bool -> Bool
not (Bool -> Bool) -> (ZDD a -> Bool) -> ZDD a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> ZDD a -> Bool
forall a. ItemOrder a => IntSet -> ZDD a -> Bool
member IntSet
xs

-- | Is this the empty family?
null :: ZDD a -> Bool
null :: ZDD a -> Bool
null = (ZDD a
forall a. ZDD a
empty ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
==)

{-# SPECIALIZE size :: ZDD a -> Int #-}
{-# SPECIALIZE size :: ZDD a -> Integer #-}
{-# SPECIALIZE size :: ZDD a -> Natural #-}
-- | The number of sets in the family.
--
-- Any 'Integral' type can be used as a result type, but it is recommended to use
-- 'Integer' or 'Natural' because the size can be larger than @Int64@ for example:
--
-- >>> size (subsets (IntSet.fromList [1..128]) :: ZDD AscOrder) :: Integer
-- 340282366920938463463374607431768211456
-- >>> import Data.Int
-- >>> maxBound :: Int64
-- 9223372036854775807
--
size :: (Integral b) => ZDD a -> b
size :: ZDD a -> b
size = (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' (\Int
_ b
n0 b
n1 -> b
n0 b -> b -> b
forall a. Num a => a -> a -> a
+ b
n1) (\Bool
b -> if Bool
b then b
1 else b
0)

-- | @(s1 \`isSubsetOf\` s2)@ indicates whether @s1@ is a subset of @s2@.
isSubsetOf :: ItemOrder a => ZDD a -> ZDD a -> Bool
isSubsetOf :: ZDD a -> ZDD a -> Bool
isSubsetOf ZDD a
a ZDD a
b = ZDD a -> ZDD a -> ZDD a
forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
union ZDD a
a ZDD a
b ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
== ZDD a
b

-- | @(s1 \`isProperSubsetOf\` s2)@ indicates whether @s1@ is a proper subset of @s2@.
isProperSubsetOf :: ItemOrder a => ZDD a -> ZDD a -> Bool
isProperSubsetOf :: ZDD a -> ZDD a -> Bool
isProperSubsetOf ZDD a
a ZDD a
b = ZDD a
a ZDD a -> ZDD a -> Bool
forall a. ItemOrder a => ZDD a -> ZDD a -> Bool
`isSubsetOf` ZDD a
b Bool -> Bool -> Bool
&& ZDD a
a ZDD a -> ZDD a -> Bool
forall a. Eq a => a -> a -> Bool
/= ZDD a
b

-- | Check whether two families are disjoint (i.e., their intersection is empty).
disjoint :: ItemOrder a => ZDD a -> ZDD a -> Bool
disjoint :: ZDD a -> ZDD a -> Bool
disjoint ZDD a
a ZDD a
b = ZDD a -> Bool
forall a. ZDD a -> Bool
null (ZDD a
a ZDD a -> ZDD a -> ZDD a
forall a. ItemOrder a => ZDD a -> ZDD a -> ZDD a
`intersection` ZDD a
b)

-- | Count the number of nodes in a ZDD viewed as a rooted directed acyclic graph.
--
-- Please do not confuse it with 'size'.
--
-- See also 'toGraph'.
numNodes :: ZDD a -> Int
numNodes :: ZDD a -> Int
numNodes (ZDD Node
node) = Node -> Int
Node.numNodes Node
node

-- | Unions of all member sets
--
-- >>> flatten (fromListOfIntSets (map IntSet.fromList [[1,2,3], [1,3], [3,4]]) :: ZDD AscOrder)
-- fromList [1,2,3,4]
flatten :: ItemOrder a => ZDD a -> IntSet
flatten :: ZDD a -> IntSet
flatten = (Int -> IntSet -> IntSet -> IntSet)
-> (Bool -> IntSet) -> ZDD a -> IntSet
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' (\Int
top IntSet
lo IntSet
hi -> Int -> IntSet -> IntSet
IntSet.insert Int
top (IntSet
lo IntSet -> IntSet -> IntSet
`IntSet.union` IntSet
hi)) (IntSet -> Bool -> IntSet
forall a b. a -> b -> a
const IntSet
IntSet.empty)

-- | Create a ZDD from a set of 'IntSet'
fromSetOfIntSets :: forall a. ItemOrder a => Set IntSet -> ZDD a
fromSetOfIntSets :: Set IntSet -> ZDD a
fromSetOfIntSets = [IntSet] -> ZDD a
forall a. ItemOrder a => [IntSet] -> ZDD a
fromListOfIntSets ([IntSet] -> ZDD a)
-> (Set IntSet -> [IntSet]) -> Set IntSet -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set IntSet -> [IntSet]
forall a. Set a -> [a]
Set.toList

-- | Convert the family to a set of 'IntSet'.
toSetOfIntSets :: ZDD a -> Set IntSet
toSetOfIntSets :: ZDD a -> Set IntSet
toSetOfIntSets = (Int -> Set IntSet -> Set IntSet -> Set IntSet)
-> (Bool -> Set IntSet) -> ZDD a -> Set IntSet
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' (\Int
top Set IntSet
lo Set IntSet
hi -> Set IntSet
lo Set IntSet -> Set IntSet -> Set IntSet
forall a. Semigroup a => a -> a -> a
<> (IntSet -> IntSet) -> Set IntSet -> Set IntSet
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Int -> IntSet -> IntSet
IntSet.insert Int
top) Set IntSet
hi) (\Bool
b -> if Bool
b then IntSet -> Set IntSet
forall a. a -> Set a
Set.singleton IntSet
IntSet.empty else Set IntSet
forall a. Set a
Set.empty)

-- | Create a ZDD from a list of 'IntSet'
fromListOfIntSets :: forall a. ItemOrder a => [IntSet] -> ZDD a
fromListOfIntSets :: [IntSet] -> ZDD a
fromListOfIntSets = [[Int]] -> ZDD a
forall a. ItemOrder a => [[Int]] -> ZDD a
fromListOfSortedList ([[Int]] -> ZDD a) -> ([IntSet] -> [[Int]]) -> [IntSet] -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntSet -> [Int]) -> [IntSet] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map IntSet -> [Int]
f
  where
    f :: IntSet -> [Int]
    f :: IntSet -> [Int]
f = (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Proxy a -> Int -> Int -> Ordering
forall a (proxy :: * -> *).
ItemOrder a =>
proxy a -> Int -> Int -> Ordering
compareItem (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) ([Int] -> [Int]) -> (IntSet -> [Int]) -> IntSet -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toList

-- | Convert the family to a list of 'IntSet'.
toListOfIntSets :: ZDD a -> [IntSet]
toListOfIntSets :: ZDD a -> [IntSet]
toListOfIntSets = (Bool, [IntSet]) -> [IntSet]
g ((Bool, [IntSet]) -> [IntSet])
-> (ZDD a -> (Bool, [IntSet])) -> ZDD a -> [IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Bool, [IntSet]) -> (Bool, [IntSet]) -> (Bool, [IntSet]))
-> (Bool -> (Bool, [IntSet])) -> ZDD a -> (Bool, [IntSet])
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' Int -> (Bool, [IntSet]) -> (Bool, [IntSet]) -> (Bool, [IntSet])
forall a. Int -> (a, [IntSet]) -> (Bool, [IntSet]) -> (a, [IntSet])
f (\Bool
b -> (Bool
b,[]))
  where
    f :: Int -> (a, [IntSet]) -> (Bool, [IntSet]) -> (a, [IntSet])
f Int
top (a
b, [IntSet]
xss) (Bool, [IntSet])
hi = (a
b, (IntSet -> IntSet) -> [IntSet] -> [IntSet]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> IntSet -> IntSet
IntSet.insert Int
top) ((Bool, [IntSet]) -> [IntSet]
g (Bool, [IntSet])
hi) [IntSet] -> [IntSet] -> [IntSet]
forall a. Semigroup a => a -> a -> a
<> [IntSet]
xss)
    g :: (Bool, [IntSet]) -> [IntSet]
g (Bool
True, [IntSet]
xss) = IntSet
IntSet.empty IntSet -> [IntSet] -> [IntSet]
forall a. a -> [a] -> [a]
: [IntSet]
xss
    g (Bool
False, [IntSet]
xss) = [IntSet]
xss

fromListOfSortedList :: forall a. ItemOrder a => [[Int]] -> ZDD a
fromListOfSortedList :: [[Int]] -> ZDD a
fromListOfSortedList = [ZDD a] -> ZDD a
forall (f :: * -> *) a.
(Foldable f, ItemOrder a) =>
f (ZDD a) -> ZDD a
unions ([ZDD a] -> ZDD a) -> ([[Int]] -> [ZDD a]) -> [[Int]] -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> ZDD a) -> [[Int]] -> [ZDD a]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> ZDD a
f
  where
    f :: [Int] -> ZDD a
    f :: [Int] -> ZDD a
f = (Int -> ZDD a -> ZDD a) -> ZDD a -> [Int] -> ZDD a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
x ZDD a
node -> Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
x ZDD a
forall a. ZDD a
Empty ZDD a
node) ZDD a
forall a. ZDD a
Base

-- | Fold over the graph structure of the ZDD.
--
-- It takes two functions that substitute 'Branch'  and 'Leaf' respectively.
--
-- Note that its type is isomorphic to @('Sig' b -> b) -> ZDD a -> b@.
fold :: (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold :: (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold Int -> b -> b -> b
br Bool -> b
lf (ZDD Node
node) = (Int -> b -> b -> b) -> (Bool -> b) -> Node -> b
forall a. (Int -> a -> a -> a) -> (Bool -> a) -> Node -> a
Node.fold Int -> b -> b -> b
br Bool -> b
lf Node
node

-- | Strict version of 'fold'
fold' :: (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' :: (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' Int -> b -> b -> b
br Bool -> b
lf (ZDD Node
node) = (Int -> b -> b -> b) -> (Bool -> b) -> Node -> b
forall a. (Int -> a -> a -> a) -> (Bool -> a) -> Node -> a
Node.fold' Int -> b -> b -> b
br Bool -> b
lf Node
node

-- ------------------------------------------------------------------------

-- | Top-down construction of ZDD, memoising internal states using 'Hashable' instance.
unfoldHashable :: forall a b. (ItemOrder a, Eq b, Hashable b) => (b -> Sig b) -> b -> ZDD a
unfoldHashable :: (b -> Sig b) -> b -> ZDD a
unfoldHashable b -> Sig b
f b
b = (forall s. ST s (ZDD a)) -> ZDD a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (ZDD a)) -> ZDD a)
-> (forall s. ST s (ZDD a)) -> ZDD a
forall a b. (a -> b) -> a -> b
$ do
  HashTable s b (Sig b)
h <- Int -> ST s (HashTable s b (Sig b))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
  let g :: [b] -> ST s ()
g [] = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      g (b
x : [b]
xs) = do
        Maybe (Sig b)
r <- HashTable s b (Sig b) -> b -> ST s (Maybe (Sig b))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s b (Sig b)
h b
x
        case Maybe (Sig b)
r of
          Just Sig b
_ -> [b] -> ST s ()
g [b]
xs
          Maybe (Sig b)
Nothing -> do
            let fx :: Sig b
fx = b -> Sig b
f b
x
            HashTable s b (Sig b) -> b -> Sig b -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s b (Sig b)
h b
x Sig b
fx
            [b] -> ST s ()
g ([b]
xs [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ Sig b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Sig b
fx)
  [b] -> ST s ()
g [b
b]
  [(b, Sig b)]
xs <- HashTable s b (Sig b) -> ST s [(b, Sig b)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s b (Sig b)
h
  let h2 :: HashMap b (ZDD a)
h2 = [(b, ZDD a)] -> HashMap b (ZDD a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(b
x, Sig (ZDD a) -> ZDD a
forall a. Sig (ZDD a) -> ZDD a
inSig ((b -> ZDD a) -> Sig b -> Sig (ZDD a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HashMap b (ZDD a)
h2 HashMap b (ZDD a) -> b -> ZDD a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.!) Sig b
s)) | (b
x,Sig b
s) <- [(b, Sig b)]
xs]
  ZDD a -> ST s (ZDD a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ZDD a -> ST s (ZDD a)) -> ZDD a -> ST s (ZDD a)
forall a b. (a -> b) -> a -> b
$ HashMap b (ZDD a)
h2 HashMap b (ZDD a) -> b -> ZDD a
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! b
b

-- | Top-down construction of ZDD, memoising internal states using 'Ord' instance.
unfoldOrd :: forall a b. (ItemOrder a, Ord b) => (b -> Sig b) -> b -> ZDD a
unfoldOrd :: (b -> Sig b) -> b -> ZDD a
unfoldOrd b -> Sig b
f b
b = Map b (ZDD a)
m2 Map b (ZDD a) -> b -> ZDD a
forall k a. Ord k => Map k a -> k -> a
Map.! b
b
  where
    m1 :: Map b (Sig b)
    m1 :: Map b (Sig b)
m1 = Map b (Sig b) -> [b] -> Map b (Sig b)
g Map b (Sig b)
forall k a. Map k a
Map.empty [b
b]

    m2 :: Map b (ZDD a)
    m2 :: Map b (ZDD a)
m2 = (Sig b -> ZDD a) -> Map b (Sig b) -> Map b (ZDD a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Sig (ZDD a) -> ZDD a
forall a. Sig (ZDD a) -> ZDD a
inSig (Sig (ZDD a) -> ZDD a) -> (Sig b -> Sig (ZDD a)) -> Sig b -> ZDD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> ZDD a) -> Sig b -> Sig (ZDD a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map b (ZDD a)
m2 Map b (ZDD a) -> b -> ZDD a
forall k a. Ord k => Map k a -> k -> a
Map.!)) Map b (Sig b)
m1

    g :: Map b (Sig b) -> [b] -> Map b (Sig b)
g Map b (Sig b)
m [] = Map b (Sig b)
m
    g Map b (Sig b)
m (b
x : [b]
xs) =
      case b -> Map b (Sig b) -> Maybe (Sig b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup b
x Map b (Sig b)
m of
        Just Sig b
_ -> Map b (Sig b) -> [b] -> Map b (Sig b)
g Map b (Sig b)
m [b]
xs
        Maybe (Sig b)
Nothing ->
          let fx :: Sig b
fx = b -> Sig b
f b
x
           in Map b (Sig b) -> [b] -> Map b (Sig b)
g (b -> Sig b -> Map b (Sig b) -> Map b (Sig b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert b
x Sig b
fx Map b (Sig b)
m) ([b]
xs [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ Sig b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Sig b
fx)

-- ------------------------------------------------------------------------

-- | Sample a set from uniform distribution over elements of the ZDD.
--
-- The function constructs a table internally and the table is shared across
-- multiple use of the resulting action (@m IntSet@).
-- Therefore, the code
--
-- @
-- let g = uniformM zdd gen
-- s1 <- g
-- s2 <- g
-- @
--
-- is more efficient than
--
-- @
-- s1 <- uniformM zdd gen
-- s2 <- uniformM zdd gen
-- @
-- .
#if MIN_VERSION_mwc_random(0,15,0)
uniformM :: forall a g m. (ItemOrder a, StatefulGen g m, HasCallStack) => ZDD a -> g -> m IntSet
#else
uniformM :: forall a m. (ItemOrder a, PrimMonad m, HasCallStack) => ZDD a -> Gen (PrimState m) -> m IntSet
#endif
uniformM :: ZDD a -> g -> m IntSet
uniformM ZDD a
Empty = String -> g -> m IntSet
forall a. HasCallStack => String -> a
error String
"Data.DecisionDiagram.ZDD.uniformM: empty ZDD"
uniformM ZDD a
zdd = g -> m IntSet
func
  where
    func :: g -> m IntSet
func g
gen = ZDD a -> [Int] -> m IntSet
f ZDD a
zdd []
      where
        f :: ZDD a -> [Int] -> m IntSet
f ZDD a
Empty [Int]
_ = String -> m IntSet
forall a. HasCallStack => String -> a
error String
"Data.DecisionDiagram.ZDD.uniformM: should not happen"
        f ZDD a
Base [Int]
r = IntSet -> m IntSet
forall (m :: * -> *) a. Monad m => a -> m a
return (IntSet -> m IntSet) -> IntSet -> m IntSet
forall a b. (a -> b) -> a -> b
$ [Int] -> IntSet
IntSet.fromList [Int]
r
        f p :: ZDD a
p@(Branch Int
top ZDD a
p0 ZDD a
p1) [Int]
r = do
          Bool
b <- Double -> g -> m Bool
forall g (m :: * -> *). StatefulGen g m => Double -> g -> m Bool
bernoulli (HashMap (ZDD a) Double
table HashMap (ZDD a) Double -> ZDD a -> Double
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HashMap.! ZDD a
p) g
gen
          if Bool
b then
            ZDD a -> [Int] -> m IntSet
f ZDD a
p1 (Int
top Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
r)
          else
            ZDD a -> [Int] -> m IntSet
f ZDD a
p0 [Int]
r

    table :: HashMap (ZDD a) Double
    table :: HashMap (ZDD a) Double
table = (forall s. ST s (HashMap (ZDD a) Double)) -> HashMap (ZDD a) Double
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (HashMap (ZDD a) Double))
 -> HashMap (ZDD a) Double)
-> (forall s. ST s (HashMap (ZDD a) Double))
-> HashMap (ZDD a) Double
forall a b. (a -> b) -> a -> b
$ do
      HashTable s (ZDD a) (Integer, Double)
h <- Int -> ST s (HashTable s (ZDD a) (Integer, Double))
forall s k v. Int -> ST s (HashTable s k v)
C.newSized Int
defaultTableSize
      let f :: ZDD a -> ST s Integer
f ZDD a
Empty = Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
0 :: Integer)
          f ZDD a
Base = Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
1
          f p :: ZDD a
p@(Branch Int
_ ZDD a
p0 ZDD a
p1) = do
            Maybe (Integer, Double)
m <- HashTable s (ZDD a) (Integer, Double)
-> ZDD a -> ST s (Maybe (Integer, Double))
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (ZDD a) (Integer, Double)
h ZDD a
p
            case Maybe (Integer, Double)
m of
              Just (Integer
ret, Double
_) -> Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
ret
              Maybe (Integer, Double)
Nothing -> do
                Integer
n0 <- ZDD a -> ST s Integer
f ZDD a
p0
                Integer
n1 <- ZDD a -> ST s Integer
f ZDD a
p1
                let s :: Integer
s = Integer
n0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n1
                    r :: Double
                    r :: Double
r = Ratio Integer -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Integer
n1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% (Integer
n0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n1))
                Double -> ST s () -> ST s ()
seq Double
r (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ HashTable s (ZDD a) (Integer, Double)
-> ZDD a -> (Integer, Double) -> ST s ()
forall (h :: * -> * -> * -> *) k s v.
(HashTable h, Eq k, Hashable k) =>
h s k v -> k -> v -> ST s ()
H.insert HashTable s (ZDD a) (Integer, Double)
h ZDD a
p (Integer
s, Double
r)
                Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
s
      Integer
_ <- ZDD a -> ST s Integer
f ZDD a
zdd
      [(ZDD a, (Integer, Double))]
xs <- HashTable s (ZDD a) (Integer, Double)
-> ST s [(ZDD a, (Integer, Double))]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
H.toList HashTable s (ZDD a) (Integer, Double)
h
      HashMap (ZDD a) Double -> ST s (HashMap (ZDD a) Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap (ZDD a) Double -> ST s (HashMap (ZDD a) Double))
-> HashMap (ZDD a) Double -> ST s (HashMap (ZDD a) Double)
forall a b. (a -> b) -> a -> b
$ [(ZDD a, Double)] -> HashMap (ZDD a) Double
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(ZDD a
n, Double
r) | (ZDD a
n, (Integer
_, Double
r)) <- [(ZDD a, (Integer, Double))]
xs]

-- ------------------------------------------------------------------------

-- | Find a minimum element set with respect to given weight function
--
-- \[
-- \min_{X\in S} \sum_{x\in X} w(x)
-- \]
findMinSum :: forall a w. (ItemOrder a, Num w, Ord w, HasCallStack) => (Int -> w) -> ZDD a -> (w, IntSet)
findMinSum :: (Int -> w) -> ZDD a -> (w, IntSet)
findMinSum Int -> w
weight =
  (w, IntSet) -> Maybe (w, IntSet) -> (w, IntSet)
forall a. a -> Maybe a -> a
fromMaybe (String -> (w, IntSet)
forall a. HasCallStack => String -> a
error String
"Data.DecisionDiagram.ZDD.findMinSum: empty ZDD") (Maybe (w, IntSet) -> (w, IntSet))
-> (ZDD a -> Maybe (w, IntSet)) -> ZDD a -> (w, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Int
 -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet))
-> (Bool -> Maybe (w, IntSet)) -> ZDD a -> Maybe (w, IntSet)
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' Int -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet)
f (\Bool
b -> if Bool
b then (w, IntSet) -> Maybe (w, IntSet)
forall a. a -> Maybe a
Just (w
0, IntSet
IntSet.empty) else Maybe (w, IntSet)
forall a. Maybe a
Nothing)
  where
    f :: Int -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet)
f Int
_ Maybe (w, IntSet)
_ Maybe (w, IntSet)
Nothing = Maybe (w, IntSet)
forall a. HasCallStack => a
undefined
    f Int
x Maybe (w, IntSet)
z1 (Just (w
w2, IntSet
s2)) =
      case Maybe (w, IntSet)
z1 of
        Just (w
w1, IntSet
_) | w
w1 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
<= w
w2' -> Maybe (w, IntSet)
z1
        Maybe (w, IntSet)
_ -> w -> Maybe (w, IntSet) -> Maybe (w, IntSet)
seq w
w2' (Maybe (w, IntSet) -> Maybe (w, IntSet))
-> Maybe (w, IntSet) -> Maybe (w, IntSet)
forall a b. (a -> b) -> a -> b
$ IntSet -> Maybe (w, IntSet) -> Maybe (w, IntSet)
seq IntSet
s2' (Maybe (w, IntSet) -> Maybe (w, IntSet))
-> Maybe (w, IntSet) -> Maybe (w, IntSet)
forall a b. (a -> b) -> a -> b
$ (w, IntSet) -> Maybe (w, IntSet)
forall a. a -> Maybe a
Just (w
w2', IntSet
s2')
      where
        w2' :: w
w2' = w
w2 w -> w -> w
forall a. Num a => a -> a -> a
+ Int -> w
weight Int
x
        s2' :: IntSet
s2' = Int -> IntSet -> IntSet
IntSet.insert Int
x IntSet
s2

-- | Find a maximum element set with respect to given weight function
--
-- \[
-- \max_{X\in S} \sum_{x\in X} w(x)
-- \]
--
-- >>> findMaxSum (IntMap.fromList [(1,2),(2,4),(3,-3)] IntMap.!) (fromListOfIntSets (map IntSet.fromList [[1], [2], [3], [1,2,3]]) :: ZDD AscOrder)
-- (4,fromList [2])
findMaxSum :: forall a w. (ItemOrder a, Num w, Ord w, HasCallStack) => (Int -> w) -> ZDD a -> (w, IntSet)
findMaxSum :: (Int -> w) -> ZDD a -> (w, IntSet)
findMaxSum Int -> w
weight =
  (w, IntSet) -> Maybe (w, IntSet) -> (w, IntSet)
forall a. a -> Maybe a -> a
fromMaybe (String -> (w, IntSet)
forall a. HasCallStack => String -> a
error String
"Data.DecisionDiagram.ZDD.findMinSum: empty ZDD") (Maybe (w, IntSet) -> (w, IntSet))
-> (ZDD a -> Maybe (w, IntSet)) -> ZDD a -> (w, IntSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Int
 -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet))
-> (Bool -> Maybe (w, IntSet)) -> ZDD a -> Maybe (w, IntSet)
forall b a. (Int -> b -> b -> b) -> (Bool -> b) -> ZDD a -> b
fold' Int -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet)
f (\Bool
b -> if Bool
b then (w, IntSet) -> Maybe (w, IntSet)
forall a. a -> Maybe a
Just (w
0, IntSet
IntSet.empty) else Maybe (w, IntSet)
forall a. Maybe a
Nothing)
  where
    f :: Int -> Maybe (w, IntSet) -> Maybe (w, IntSet) -> Maybe (w, IntSet)
f Int
_ Maybe (w, IntSet)
_ Maybe (w, IntSet)
Nothing = Maybe (w, IntSet)
forall a. HasCallStack => a
undefined
    f Int
x Maybe (w, IntSet)
z1 (Just (w
w2, IntSet
s2)) =
      case Maybe (w, IntSet)
z1 of
        Just (w
w1, IntSet
_) | w
w1 w -> w -> Bool
forall a. Ord a => a -> a -> Bool
>= w
w2' -> Maybe (w, IntSet)
z1
        Maybe (w, IntSet)
_ -> w -> Maybe (w, IntSet) -> Maybe (w, IntSet)
seq w
w2' (Maybe (w, IntSet) -> Maybe (w, IntSet))
-> Maybe (w, IntSet) -> Maybe (w, IntSet)
forall a b. (a -> b) -> a -> b
$ IntSet -> Maybe (w, IntSet) -> Maybe (w, IntSet)
seq IntSet
s2' (Maybe (w, IntSet) -> Maybe (w, IntSet))
-> Maybe (w, IntSet) -> Maybe (w, IntSet)
forall a b. (a -> b) -> a -> b
$ (w, IntSet) -> Maybe (w, IntSet)
forall a. a -> Maybe a
Just (w
w2', IntSet
s2')
      where
        w2' :: w
w2' = w
w2 w -> w -> w
forall a. Num a => a -> a -> a
+ Int -> w
weight Int
x
        s2' :: IntSet
s2' = Int -> IntSet -> IntSet
IntSet.insert Int
x IntSet
s2

-- ------------------------------------------------------------------------

-- | Synonym of @'SLeaf' False@
pattern SEmpty :: Sig a
pattern $bSEmpty :: Sig a
$mSEmpty :: forall r a. Sig a -> (Void# -> r) -> (Void# -> r) -> r
SEmpty = SLeaf False

-- | Synonym of @'SLeaf' True@
pattern SBase :: Sig a
pattern $bSBase :: Sig a
$mSBase :: forall r a. Sig a -> (Void# -> r) -> (Void# -> r) -> r
SBase = SLeaf True

-- | 'Sig'-algebra stucture of 'ZDD', \(\mathrm{in}_\mathrm{Sig}\).
inSig :: Sig (ZDD a) -> ZDD a
inSig :: Sig (ZDD a) -> ZDD a
inSig (SLeaf Bool
b) = Bool -> ZDD a
forall a. Bool -> ZDD a
Leaf Bool
b
inSig (SBranch Int
x ZDD a
lo ZDD a
hi) = Int -> ZDD a -> ZDD a -> ZDD a
forall a. Int -> ZDD a -> ZDD a -> ZDD a
Branch Int
x ZDD a
lo ZDD a
hi

-- | 'Sig'-coalgebra stucture of 'ZDD', \(\mathrm{out}_\mathrm{Sig}\).
outSig :: ZDD a -> Sig (ZDD a)
outSig :: ZDD a -> Sig (ZDD a)
outSig (Leaf Bool
b) = Bool -> Sig (ZDD a)
forall a. Bool -> Sig a
SLeaf Bool
b
outSig (Branch Int
x ZDD a
lo ZDD a
hi) = Int -> ZDD a -> ZDD a -> Sig (ZDD a)
forall a. Int -> a -> a -> Sig a
SBranch Int
x ZDD a
lo ZDD a
hi

-- ------------------------------------------------------------------------

-- | Convert a ZDD into a pointed graph
--
-- Nodes @0@ and @1@ are reserved for @SLeaf False@ and @SLeaf True@ even if
-- they are not actually used. Therefore the result may be larger than
-- 'numNodes' if the leaf nodes are not used.
toGraph :: ZDD a -> (Graph Sig, Int)
toGraph :: ZDD a -> (Graph Sig, Int)
toGraph (ZDD Node
node) = Node -> (Graph Sig, Int)
Node.toGraph Node
node

-- | Convert multiple ZDDs into a graph
toGraph' :: Traversable t => t (ZDD a) -> (Graph Sig, t Int)
toGraph' :: t (ZDD a) -> (Graph Sig, t Int)
toGraph' t (ZDD a)
bs = t Node -> (Graph Sig, t Int)
forall (t :: * -> *). Traversable t => t Node -> (Graph Sig, t Int)
Node.toGraph' ((ZDD a -> Node) -> t (ZDD a) -> t Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ZDD Node
node) -> Node
node) t (ZDD a)
bs)

-- | Convert a pointed graph into a ZDD
fromGraph :: HasCallStack => (Graph Sig, Int) -> ZDD a
fromGraph :: (Graph Sig, Int) -> ZDD a
fromGraph = (Sig (ZDD a) -> ZDD a) -> (Graph Sig, Int) -> ZDD a
forall (f :: * -> *) a.
(Functor f, HasCallStack) =>
(f a -> a) -> (Graph f, Int) -> a
Node.foldGraph Sig (ZDD a) -> ZDD a
forall a. Sig (ZDD a) -> ZDD a
inSig

-- | Convert nodes of a graph into ZDDs
fromGraph' :: HasCallStack => Graph Sig -> IntMap (ZDD a)
fromGraph' :: Graph Sig -> IntMap (ZDD a)
fromGraph' = (Sig (ZDD a) -> ZDD a) -> Graph Sig -> IntMap (ZDD a)
forall (f :: * -> *) a.
(Functor f, HasCallStack) =>
(f a -> a) -> Graph f -> IntMap a
Node.foldGraphNodes Sig (ZDD a) -> ZDD a
forall a. Sig (ZDD a) -> ZDD a
inSig

-- ------------------------------------------------------------------------