{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
module GHC.Data.Graph.Inductive.PatriciaTree
( Gr
, UGr
)
where
import GHC.Prelude
import GHC.Data.Graph.Inductive.Graph
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.List (sort)
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
import qualified Data.IntMap.Strict as IMS
import GHC.Generics (Generic)
import Data.Bifunctor
newtype Gr a b = Gr (GraphRep a b)
deriving ((forall x. Gr a b -> Rep (Gr a b) x)
-> (forall x. Rep (Gr a b) x -> Gr a b) -> Generic (Gr a b)
forall x. Rep (Gr a b) x -> Gr a b
forall x. Gr a b -> Rep (Gr a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Gr a b) x -> Gr a b
forall a b x. Gr a b -> Rep (Gr a b) x
$cfrom :: forall a b x. Gr a b -> Rep (Gr a b) x
from :: forall x. Gr a b -> Rep (Gr a b) x
$cto :: forall a b x. Rep (Gr a b) x -> Gr a b
to :: forall x. Rep (Gr a b) x -> Gr a b
Generic)
type GraphRep a b = IntMap (Context' a b)
type Context' a b = (IntMap [b], a, IntMap [b])
type UGr = Gr () ()
instance (Eq a, Ord b) => Eq (Gr a b) where
(Gr IntMap (IntMap [b], a, IntMap [b])
g1) == :: Gr a b -> Gr a b -> Bool
== (Gr IntMap (IntMap [b], a, IntMap [b])
g2) = ((IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b]))
-> IntMap (IntMap [b], a, IntMap [b])
-> IntMap (IntMap [b], a, IntMap [b])
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
forall {f :: * -> *} {f :: * -> *} {a} {a} {b}.
(Functor f, Functor f, Ord a, Ord a) =>
(f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj IntMap (IntMap [b], a, IntMap [b])
g1 IntMap (IntMap [b], a, IntMap [b])
-> IntMap (IntMap [b], a, IntMap [b]) -> Bool
forall a. Eq a => a -> a -> Bool
== ((IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b]))
-> IntMap (IntMap [b], a, IntMap [b])
-> IntMap (IntMap [b], a, IntMap [b])
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
forall {f :: * -> *} {f :: * -> *} {a} {a} {b}.
(Functor f, Functor f, Ord a, Ord a) =>
(f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj IntMap (IntMap [b], a, IntMap [b])
g2
where
sortAdj :: (f [a], b, f [a]) -> (f [a], b, f [a])
sortAdj (f [a]
p,b
n,f [a]
s) = (([a] -> [a]) -> f [a] -> f [a]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. Ord a => [a] -> [a]
sort f [a]
p,b
n,([a] -> [a]) -> f [a] -> f [a]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. Ord a => [a] -> [a]
sort f [a]
s)
instance (Show a, Show b) => Show (Gr a b) where
showsPrec :: Int -> Gr a b -> ShowS
showsPrec Int
d Gr a b
g = 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
"mkGraph "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LNode a] -> ShowS
forall a. Show a => a -> ShowS
shows (Gr a b -> [LNode a]
forall a b. Gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes Gr a b
g)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEdge b] -> ShowS
forall a. Show a => a -> ShowS
shows (Gr a b -> [LEdge b]
forall a b. Gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges Gr a b
g)
instance (Read a, Read b) => Read (Gr a b) where
readsPrec :: Int -> ReadS (Gr a b)
readsPrec Int
p = Bool -> ReadS (Gr a b) -> ReadS (Gr a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Gr a b) -> ReadS (Gr a b))
-> ReadS (Gr a b) -> ReadS (Gr a b)
forall a b. (a -> b) -> a -> b
$ \ String
r -> do
(String
"mkGraph", String
s) <- ReadS String
lex String
r
([LNode a]
ns,String
t) <- ReadS [LNode a]
forall a. Read a => ReadS a
reads String
s
([LEdge b]
es,String
u) <- ReadS [LEdge b]
forall a. Read a => ReadS a
reads String
t
(Gr a b, String) -> [(Gr a b, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LNode a] -> [LEdge b] -> Gr a b
forall a b. [LNode a] -> [LEdge b] -> Gr a b
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode a]
ns [LEdge b]
es, String
u)
instance Graph Gr where
empty :: forall a b. Gr a b
empty = GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
forall a. IntMap a
IM.empty
isEmpty :: forall a b. Gr a b -> Bool
isEmpty (Gr GraphRep a b
g) = GraphRep a b -> Bool
forall a. IntMap a -> Bool
IM.null GraphRep a b
g
match :: forall a b. Int -> Gr a b -> Decomp Gr a b
match = Int -> Gr a b -> Decomp Gr a b
forall a b. Int -> Gr a b -> Decomp Gr a b
matchGr
mkGraph :: forall a b. [LNode a] -> [LEdge b] -> Gr a b
mkGraph [LNode a]
vs [LEdge b]
es = [LEdge b] -> Gr a b -> Gr a b
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
insEdges [LEdge b]
es
(Gr a b -> Gr a b) -> ([LNode a] -> Gr a b) -> [LNode a] -> Gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr
(GraphRep a b -> Gr a b)
-> ([LNode a] -> GraphRep a b) -> [LNode a] -> Gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Context' a b)] -> GraphRep a b
forall a. [(Int, a)] -> IntMap a
IM.fromList
([(Int, Context' a b)] -> GraphRep a b)
-> ([LNode a] -> [(Int, Context' a b)])
-> [LNode a]
-> GraphRep a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LNode a -> (Int, Context' a b))
-> [LNode a] -> [(Int, Context' a b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Context' a b) -> LNode a -> (Int, Context' a b)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\a
l -> (IntMap [b]
forall a. IntMap a
IM.empty,a
l,IntMap [b]
forall a. IntMap a
IM.empty)))
([LNode a] -> Gr a b) -> [LNode a] -> Gr a b
forall a b. (a -> b) -> a -> b
$ [LNode a]
vs
labNodes :: forall a b. Gr a b -> [LNode a]
labNodes (Gr GraphRep a b
g) = [ (Int
node, a
label)
| (Int
node, (IntMap [b]
_, a
label, IntMap [b]
_)) <- GraphRep a b -> [(Int, Context' a b)]
forall a. IntMap a -> [(Int, a)]
IM.toList GraphRep a b
g ]
noNodes :: forall a b. Gr a b -> Int
noNodes (Gr GraphRep a b
g) = GraphRep a b -> Int
forall a. IntMap a -> Int
IM.size GraphRep a b
g
nodeRange :: forall a b. Gr a b -> (Int, Int)
nodeRange (Gr GraphRep a b
g) = (Int, Int) -> Maybe (Int, Int) -> (Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"nodeRange of empty graph")
(Maybe (Int, Int) -> (Int, Int)) -> Maybe (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe Int -> Maybe (Int, Int)
forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Maybe ((Int, Context' a b), GraphRep a b) -> Maybe Int
forall {b} {b} {b}. Maybe ((b, b), b) -> Maybe b
ix (GraphRep a b -> Maybe ((Int, Context' a b), GraphRep a b)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IM.minViewWithKey GraphRep a b
g))
(Maybe ((Int, Context' a b), GraphRep a b) -> Maybe Int
forall {b} {b} {b}. Maybe ((b, b), b) -> Maybe b
ix (GraphRep a b -> Maybe ((Int, Context' a b), GraphRep a b)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
IM.maxViewWithKey GraphRep a b
g))
where
ix :: Maybe ((b, b), b) -> Maybe b
ix = (((b, b), b) -> b) -> Maybe ((b, b), b) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, b) -> b
forall a b. (a, b) -> a
fst ((b, b) -> b) -> (((b, b), b) -> (b, b)) -> ((b, b), b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b), b) -> (b, b)
forall a b. (a, b) -> a
fst)
labEdges :: forall a b. Gr a b -> [LEdge b]
labEdges (Gr GraphRep a b
g) = do (Int
node, (IntMap [b]
_, a
_, IntMap [b]
s)) <- GraphRep a b -> [(Int, Context' a b)]
forall a. IntMap a -> [(Int, a)]
IM.toList GraphRep a b
g
(Int
next, [b]
labels) <- IntMap [b] -> [(Int, [b])]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap [b]
s
b
label <- [b]
labels
LEdge b -> [LEdge b]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
node, Int
next, b
label)
instance DynGraph Gr where
(Adj b
p, Int
v, a
l, Adj b
s) & :: forall a b. Context a b -> Gr a b -> Gr a b
& (Gr GraphRep a b
g)
= let !g1 :: GraphRep a b
g1 = Int -> (IntMap [b], a, IntMap [b]) -> GraphRep a b -> GraphRep a b
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
v (IntMap [b]
preds, a
l, IntMap [b]
succs) GraphRep a b
g
!(Int
np, IntMap [b]
preds) = Adj b -> (Int, IntMap [b])
forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting Adj b
p
!(Int
ns, IntMap [b]
succs) = Adj b -> (Int, IntMap [b])
forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting Adj b
s
!g2 :: GraphRep a b
g2 = GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addSucc GraphRep a b
g1 Int
v Int
np IntMap [b]
preds
!g3 :: GraphRep a b
g3 = GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addPred GraphRep a b
g2 Int
v Int
ns IntMap [b]
succs
in GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g3
instance Functor (Gr a) where
fmap :: forall a b. (a -> b) -> Gr a a -> Gr a b
fmap = (a -> b) -> Gr a a -> Gr a b
forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap
instance Bifunctor Gr where
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Gr a c -> Gr b d
bimap = (a -> b) -> (c -> d) -> Gr a c -> Gr b d
forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap
first :: forall a b c. (a -> b) -> Gr a c -> Gr b c
first = (a -> b) -> Gr a c -> Gr b c
forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap
second :: forall b c a. (b -> c) -> Gr a b -> Gr a c
second = (b -> c) -> Gr a b -> Gr a c
forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap
matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr :: forall a b. Int -> Gr a b -> Decomp Gr a b
matchGr Int
node (Gr GraphRep a b
g)
= case Int -> GraphRep a b -> Maybe (Context' a b)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
node GraphRep a b
g of
Maybe (Context' a b)
Nothing
-> (Maybe (Context a b)
forall a. Maybe a
Nothing, GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g)
Just (IntMap [b]
p, a
label, IntMap [b]
s)
-> let !g1 :: GraphRep a b
g1 = Int -> GraphRep a b -> GraphRep a b
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node GraphRep a b
g
!p' :: IntMap [b]
p' = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node IntMap [b]
p
!s' :: IntMap [b]
s' = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
node IntMap [b]
s
!g2 :: GraphRep a b
g2 = GraphRep a b -> Int -> IntMap [b] -> GraphRep a b
forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearPred GraphRep a b
g1 Int
node IntMap [b]
s'
!g3 :: GraphRep a b
g3 = GraphRep a b -> Int -> IntMap [b] -> GraphRep a b
forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearSucc GraphRep a b
g2 Int
node IntMap [b]
p'
in (Context a b -> Maybe (Context a b)
forall a. a -> Maybe a
Just (IntMap [b] -> Adj b
forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
p', Int
node, a
label, IntMap [b] -> Adj b
forall b. IntMap [b] -> Adj b
toAdj IntMap [b]
s), GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g3)
{-# RULES
"insEdge/GHC.Data.Graph.Inductive.PatriciaTree" insEdge = fastInsEdge
#-}
fastInsEdge :: LEdge b -> Gr a b -> Gr a b
fastInsEdge :: forall b a. LEdge b -> Gr a b -> Gr a b
fastInsEdge (Int
v, Int
w, b
l) (Gr GraphRep a b
g) = GraphRep a b
g2 GraphRep a b -> Gr a b -> Gr a b
forall a b. a -> b -> b
`seq` GraphRep a b -> Gr a b
forall a b. GraphRep a b -> Gr a b
Gr GraphRep a b
g2
where
g1 :: GraphRep a b
g1 = ((IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b]))
-> Int -> GraphRep a b -> GraphRep a b
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
addS' Int
v GraphRep a b
g
g2 :: GraphRep a b
g2 = ((IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b]))
-> Int -> GraphRep a b -> GraphRep a b
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
addP' Int
w GraphRep a b
g1
addS' :: (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
addS' (IntMap [b]
ps, a
l', IntMap [b]
ss) = (IntMap [b]
ps, a
l', ([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
w [b
l] IntMap [b]
ss)
addP' :: (IntMap [b], a, IntMap [b]) -> (IntMap [b], a, IntMap [b])
addP' (IntMap [b]
ps, a
l', IntMap [b]
ss) = (([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
v [b
l] IntMap [b]
ps, a
l', IntMap [b]
ss)
fastNMap :: forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap :: forall a b c. (a -> c) -> Gr a b -> Gr c b
fastNMap a -> c
f (Gr GraphRep a b
g) = GraphRep c b -> Gr c b
forall a b. GraphRep a b -> Gr a b
Gr ((Context' a b -> Context' c b) -> GraphRep a b -> GraphRep c b
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' c b
f' GraphRep a b
g)
where
f' :: Context' a b -> Context' c b
f' :: Context' a b -> Context' c b
f' (IntMap [b]
ps, a
a, IntMap [b]
ss) = (IntMap [b]
ps, a -> c
f a
a, IntMap [b]
ss)
fastEMap :: forall a b c. (b -> c) -> Gr a b -> Gr a c
fastEMap :: forall a a b. (a -> b) -> Gr a a -> Gr a b
fastEMap b -> c
f (Gr GraphRep a b
g) = GraphRep a c -> Gr a c
forall a b. GraphRep a b -> Gr a b
Gr ((Context' a b -> Context' a c) -> GraphRep a b -> GraphRep a c
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' a c
f' GraphRep a b
g)
where
f' :: Context' a b -> Context' a c
f' :: Context' a b -> Context' a c
f' (IntMap [b]
ps, a
a, IntMap [b]
ss) = (([b] -> [c]) -> IntMap [b] -> IntMap [c]
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map ((b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map b -> c
f) IntMap [b]
ps, a
a, ([b] -> [c]) -> IntMap [b] -> IntMap [c]
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map ((b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map b -> c
f) IntMap [b]
ss)
fastNEMap :: forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap :: forall a b c d. (a -> c) -> (b -> d) -> Gr a b -> Gr c d
fastNEMap a -> c
fn b -> d
fe (Gr GraphRep a b
g) = GraphRep c d -> Gr c d
forall a b. GraphRep a b -> Gr a b
Gr ((Context' a b -> Context' c d) -> GraphRep a b -> GraphRep c d
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map Context' a b -> Context' c d
f GraphRep a b
g)
where
f :: Context' a b -> Context' c d
f :: Context' a b -> Context' c d
f (IntMap [b]
ps, a
a, IntMap [b]
ss) = (([b] -> [d]) -> IntMap [b] -> IntMap [d]
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map ((b -> d) -> [b] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map b -> d
fe) IntMap [b]
ps, a -> c
fn a
a, ([b] -> [d]) -> IntMap [b] -> IntMap [d]
forall a b. (a -> b) -> IntMap a -> IntMap b
IM.map ((b -> d) -> [b] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map b -> d
fe) IntMap [b]
ss)
toAdj :: IntMap [b] -> Adj b
toAdj :: forall b. IntMap [b] -> Adj b
toAdj = ((Int, [b]) -> [(b, Int)]) -> [(Int, [b])] -> [(b, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [b]) -> [(b, Int)]
forall {b} {a}. (b, [a]) -> [(a, b)]
expand ([(Int, [b])] -> [(b, Int)])
-> (IntMap [b] -> [(Int, [b])]) -> IntMap [b] -> [(b, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [b] -> [(Int, [b])]
forall a. IntMap a -> [(Int, a)]
IM.toList
where
expand :: (b, [a]) -> [(a, b)]
expand (b
n,[a]
ls) = (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b -> (a, b)) -> b -> a -> (a, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
n) [a]
ls
data FromListCounting a = FromListCounting !Int !(IntMap a)
deriving (FromListCounting a -> FromListCounting a -> Bool
(FromListCounting a -> FromListCounting a -> Bool)
-> (FromListCounting a -> FromListCounting a -> Bool)
-> Eq (FromListCounting a)
forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
== :: FromListCounting a -> FromListCounting a -> Bool
$c/= :: forall a. Eq a => FromListCounting a -> FromListCounting a -> Bool
/= :: FromListCounting a -> FromListCounting a -> Bool
Eq, Int -> FromListCounting a -> ShowS
[FromListCounting a] -> ShowS
FromListCounting a -> String
(Int -> FromListCounting a -> ShowS)
-> (FromListCounting a -> String)
-> ([FromListCounting a] -> ShowS)
-> Show (FromListCounting a)
forall a. Show a => Int -> FromListCounting a -> ShowS
forall a. Show a => [FromListCounting a] -> ShowS
forall a. Show a => FromListCounting a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FromListCounting a -> ShowS
showsPrec :: Int -> FromListCounting a -> ShowS
$cshow :: forall a. Show a => FromListCounting a -> String
show :: FromListCounting a -> String
$cshowList :: forall a. Show a => [FromListCounting a] -> ShowS
showList :: [FromListCounting a] -> ShowS
Show, ReadPrec [FromListCounting a]
ReadPrec (FromListCounting a)
Int -> ReadS (FromListCounting a)
ReadS [FromListCounting a]
(Int -> ReadS (FromListCounting a))
-> ReadS [FromListCounting a]
-> ReadPrec (FromListCounting a)
-> ReadPrec [FromListCounting a]
-> Read (FromListCounting a)
forall a. Read a => ReadPrec [FromListCounting a]
forall a. Read a => ReadPrec (FromListCounting a)
forall a. Read a => Int -> ReadS (FromListCounting a)
forall a. Read a => ReadS [FromListCounting a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (FromListCounting a)
readsPrec :: Int -> ReadS (FromListCounting a)
$creadList :: forall a. Read a => ReadS [FromListCounting a]
readList :: ReadS [FromListCounting a]
$creadPrec :: forall a. Read a => ReadPrec (FromListCounting a)
readPrec :: ReadPrec (FromListCounting a)
$creadListPrec :: forall a. Read a => ReadPrec [FromListCounting a]
readListPrec :: ReadPrec [FromListCounting a]
Read)
getFromListCounting :: FromListCounting a -> (Int, IntMap a)
getFromListCounting :: forall a. FromListCounting a -> (Int, IntMap a)
getFromListCounting (FromListCounting Int
i IntMap a
m) = (Int
i, IntMap a
m)
{-# INLINE getFromListCounting #-}
fromListWithKeyCounting :: (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting :: forall a. (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting Int -> a -> a -> a
f = FromListCounting a -> (Int, IntMap a)
forall a. FromListCounting a -> (Int, IntMap a)
getFromListCounting (FromListCounting a -> (Int, IntMap a))
-> ([(Int, a)] -> FromListCounting a)
-> [(Int, a)]
-> (Int, IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FromListCounting a -> (Int, a) -> FromListCounting a)
-> FromListCounting a -> [(Int, a)] -> FromListCounting a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' FromListCounting a -> (Int, a) -> FromListCounting a
ins (Int -> IntMap a -> FromListCounting a
forall a. Int -> IntMap a -> FromListCounting a
FromListCounting Int
0 IntMap a
forall a. IntMap a
IM.empty)
where
ins :: FromListCounting a -> (Int, a) -> FromListCounting a
ins (FromListCounting Int
i IntMap a
t) (Int
k,a
x) = Int -> IntMap a -> FromListCounting a
forall a. Int -> IntMap a -> FromListCounting a
FromListCounting (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
t)
{-# INLINE fromListWithKeyCounting #-}
fromListWithCounting :: (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting :: forall a. (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting a -> a -> a
f = (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
forall a. (Int -> a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithKeyCounting (\Int
_ a
x a
y -> a -> a -> a
f a
x a
y)
{-# INLINE fromListWithCounting #-}
fromAdjCounting :: Adj b -> (Int, IntMap [b])
fromAdjCounting :: forall b. Adj b -> (Int, IntMap [b])
fromAdjCounting = ([b] -> [b] -> [b]) -> [(Int, [b])] -> (Int, IntMap [b])
forall a. (a -> a -> a) -> [(Int, a)] -> (Int, IntMap a)
fromListWithCounting [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists ([(Int, [b])] -> (Int, IntMap [b]))
-> (Adj b -> [(Int, [b])]) -> Adj b -> (Int, IntMap [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Int) -> (Int, [b])) -> Adj b -> [(Int, [b])]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> [b]) -> (Int, b) -> (Int, [b])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[]) ((Int, b) -> (Int, [b]))
-> ((b, Int) -> (Int, b)) -> (b, Int) -> (Int, [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Int) -> (Int, b)
forall a b. (a, b) -> (b, a)
swap)
bulkThreshold :: Int
bulkThreshold :: Int
bulkThreshold = Int
5
addLists :: [a] -> [a] -> [a]
addLists :: forall a. [a] -> [a] -> [a]
addLists [a
a] [a]
as = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
addLists [a]
as [a
a] = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
addLists [a]
xs [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys
addSucc :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b
addSucc :: forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addSucc GraphRep a b
g0 Int
v Int
numAdd IntMap [b]
xs
| Int
numAdd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bulkThreshold = (GraphRep a b -> Int -> [b] -> GraphRep a b)
-> GraphRep a b -> IntMap [b] -> GraphRep a b
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g0 IntMap [b]
xs
where
go :: GraphRep a b -> Node -> [b] -> GraphRep a b
go :: GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g Int
p [b]
l = (Context' a b -> Context' a b)
-> Int -> GraphRep a b -> GraphRep a b
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IMS.adjust Context' a b -> Context' a b
f Int
p GraphRep a b
g
where f :: Context' a b -> Context' a b
f (IntMap [b]
ps, a
l', IntMap [b]
ss) = let !ss' :: IntMap [b]
ss' = ([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ss
in (IntMap [b]
ps, a
l', IntMap [b]
ss')
addSucc GraphRep a b
g Int
v Int
_ IntMap [b]
xs = (Context' a b -> [b] -> Maybe (Context' a b))
-> GraphRep a b -> IntMap [b] -> GraphRep a b
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> [b] -> Maybe (Context' a b)
go GraphRep a b
g IntMap [b]
xs
where
go :: Context' a b -> [b] -> Maybe (Context' a b)
go :: Context' a b -> [b] -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l', IntMap [b]
ss) [b]
l = let !ss' :: IntMap [b]
ss' = ([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ss
in Context' a b -> Maybe (Context' a b)
forall a. a -> Maybe a
Just (IntMap [b]
ps, a
l', IntMap [b]
ss')
foldlWithKey' :: (a -> IM.Key -> b -> a) -> a -> IntMap b -> a
foldlWithKey' :: forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' =
(a -> Int -> b -> a) -> a -> IntMap b -> a
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IM.foldlWithKey'
addPred :: forall a b . GraphRep a b -> Node -> Int -> IM.IntMap [b] -> GraphRep a b
addPred :: forall a b.
GraphRep a b -> Int -> Int -> IntMap [b] -> GraphRep a b
addPred GraphRep a b
g0 Int
v Int
numAdd IntMap [b]
xs
| Int
numAdd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bulkThreshold = (GraphRep a b -> Int -> [b] -> GraphRep a b)
-> GraphRep a b -> IntMap [b] -> GraphRep a b
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g0 IntMap [b]
xs
where
go :: GraphRep a b -> Node -> [b] -> GraphRep a b
go :: GraphRep a b -> Int -> [b] -> GraphRep a b
go GraphRep a b
g Int
p [b]
l = (Context' a b -> Context' a b)
-> Int -> GraphRep a b -> GraphRep a b
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IMS.adjust Context' a b -> Context' a b
f Int
p GraphRep a b
g
where f :: Context' a b -> Context' a b
f (IntMap [b]
ps, a
l', IntMap [b]
ss) = let !ps' :: IntMap [b]
ps' = ([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ps
in (IntMap [b]
ps', a
l', IntMap [b]
ss)
addPred GraphRep a b
g Int
v Int
_ IntMap [b]
xs = (Context' a b -> [b] -> Maybe (Context' a b))
-> GraphRep a b -> IntMap [b] -> GraphRep a b
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> [b] -> Maybe (Context' a b)
go GraphRep a b
g IntMap [b]
xs
where
go :: Context' a b -> [b] -> Maybe (Context' a b)
go :: Context' a b -> [b] -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l', IntMap [b]
ss) [b]
l = let !ps' :: IntMap [b]
ps' = ([b] -> [b] -> [b]) -> Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
addLists Int
v [b]
l IntMap [b]
ps
in Context' a b -> Maybe (Context' a b)
forall a. a -> Maybe a
Just (IntMap [b]
ps', a
l', IntMap [b]
ss)
clearSucc :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
clearSucc :: forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearSucc GraphRep a b
g Int
v = (Context' a b -> x -> Maybe (Context' a b))
-> GraphRep a b -> IntMap x -> GraphRep a b
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> x -> Maybe (Context' a b)
go GraphRep a b
g
where
go :: Context' a b -> x -> Maybe (Context' a b)
go :: Context' a b -> x -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l, IntMap [b]
ss) x
_ = let !ss' :: IntMap [b]
ss' = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
v IntMap [b]
ss
in Context' a b -> Maybe (Context' a b)
forall a. a -> Maybe a
Just (IntMap [b]
ps, a
l, IntMap [b]
ss')
clearPred :: forall a b x . GraphRep a b -> Node -> IM.IntMap x -> GraphRep a b
clearPred :: forall a b x. GraphRep a b -> Int -> IntMap x -> GraphRep a b
clearPred GraphRep a b
g Int
v = (Context' a b -> x -> Maybe (Context' a b))
-> GraphRep a b -> IntMap x -> GraphRep a b
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
IMS.differenceWith Context' a b -> x -> Maybe (Context' a b)
go GraphRep a b
g
where
go :: Context' a b -> x -> Maybe (Context' a b)
go :: Context' a b -> x -> Maybe (Context' a b)
go (IntMap [b]
ps, a
l, IntMap [b]
ss) x
_ = let !ps' :: IntMap [b]
ps' = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
v IntMap [b]
ps
in Context' a b -> Maybe (Context' a b)
forall a. a -> Maybe a
Just (IntMap [b]
ps', a
l, IntMap [b]
ss)