{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Data.DecisionDiagram.ZDD
(
ZDD (Leaf, Branch)
, pattern Empty
, pattern Base
, ItemOrder (..)
, AscOrder
, DescOrder
, withDefaultOrder
, withAscOrder
, withDescOrder
, withCustomOrder
, empty
, base
, singleton
, subsets
, combinations
, fromListOfIntSets
, fromSetOfIntSets
, subsetsAtLeast
, subsetsAtMost
, subsetsExactly
, subsetsExactlyIntegral
, insert
, delete
, member
, notMember
, null
, size
, isSubsetOf
, isProperSubsetOf
, disjoint
, numNodes
, union
, unions
, intersection
, difference
, (\\)
, nonSuperset
, subset1
, subset0
, mapInsert
, mapDelete
, change
, Sig (..)
, pattern SEmpty
, pattern SBase
, inSig
, outSig
, fold
, fold'
, unfoldHashable
, unfoldOrd
, minimalHittingSets
, minimalHittingSetsToda
, minimalHittingSetsKnuth
, minimalHittingSetsImai
, uniformM
, findMinSum
, findMaxSum
, flatten
, toListOfIntSets
, toSetOfIntSets
, 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
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)
pattern Empty :: ZDD a
pattern $bEmpty :: ZDD a
$mEmpty :: forall r a. ZDD a -> (Void# -> r) -> (Void# -> r) -> r
Empty = Leaf False
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)
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 #-}
#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
empty :: ZDD a
empty :: ZDD a
empty = ZDD a
forall a. ZDD a
Empty
base :: ZDD a
base :: ZDD a
base = ZDD a
forall a. ZDD a
Base
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
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
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)
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)
| 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
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)
| 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
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
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
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
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 :: 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 :: 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)
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
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 :: 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 :: 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 :: 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 :: 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 :: 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
(\\) :: 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
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
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
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
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
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
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
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
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 #-}
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)
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
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
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)
numNodes :: ZDD a -> Int
numNodes :: ZDD a -> Int
numNodes (ZDD Node
node) = Node -> Int
Node.numNodes Node
node
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)
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
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)
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
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 :: (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
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
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
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)
#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]
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
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
pattern SEmpty :: Sig a
pattern $bSEmpty :: Sig a
$mSEmpty :: forall r a. Sig a -> (Void# -> r) -> (Void# -> r) -> r
SEmpty = SLeaf False
pattern SBase :: Sig a
pattern $bSBase :: Sig a
$mSBase :: forall r a. Sig a -> (Void# -> r) -> (Void# -> r) -> r
SBase = SLeaf True
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
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
toGraph :: ZDD a -> (Graph Sig, Int)
toGraph :: ZDD a -> (Graph Sig, Int)
toGraph (ZDD Node
node) = Node -> (Graph Sig, Int)
Node.toGraph Node
node
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)
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
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