{-# LANGUAGE TypeFamilies #-}
module Data.Graph.Haggle.BiDigraph (
MBiDigraph,
BiDigraph,
newMBiDigraph,
newSizedMBiDigraph
) where
import Control.Monad ( when )
import qualified Control.Monad.Primitive as P
import qualified Control.Monad.Ref as R
import Data.IntMap ( IntMap )
import qualified Data.IntMap as IM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector as V
import Data.Graph.Haggle.Classes
import Data.Graph.Haggle.Internal.Basic
data MBiDigraph m =
MBiDigraph { forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount :: R.Ref m Int
, forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeCount :: R.Ref m Int
, forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeIdSrc :: R.Ref m Int
, forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds :: R.Ref m (MV.MVector (P.PrimState m) (IntMap [Edge]))
, forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs :: R.Ref m (MV.MVector (P.PrimState m) (IntMap [Edge]))
}
data BiDigraph =
BiDigraph { BiDigraph -> Int
vertexCount :: {-# UNPACK #-} !Int
, BiDigraph -> Int
edgeCount :: {-# UNPACK #-} !Int
, BiDigraph -> Int
edgeIdSrc :: {-# UNPACK #-} !Int
, BiDigraph -> Vector (IntMap [Edge])
graphPreds :: V.Vector (IntMap [Edge])
, BiDigraph -> Vector (IntMap [Edge])
graphSuccs :: V.Vector (IntMap [Edge])
}
defaultSize :: Int
defaultSize :: Int
defaultSize = Int
128
newMBiDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MBiDigraph m)
newMBiDigraph :: forall (m :: * -> *). (PrimMonad m, MonadRef m) => m (MBiDigraph m)
newMBiDigraph = forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
Int -> Int -> m (MBiDigraph m)
newSizedMBiDigraph Int
defaultSize Int
0
newSizedMBiDigraph :: (P.PrimMonad m, R.MonadRef m)
=> Int
-> Int
-> m (MBiDigraph m)
newSizedMBiDigraph :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
Int -> Int -> m (MBiDigraph m)
newSizedMBiDigraph Int
szNodes Int
_ = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
szNodes forall a. Ord a => a -> a -> Bool
< Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"newSizedMBiDigraph: Negative size"
Ref m Int
nn <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef Int
0
Ref m Int
en <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef Int
0
Ref m Int
esrc <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef Int
0
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szNodes
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MV.new Int
szNodes
Ref m (MVector (PrimState m) (IntMap [Edge]))
pref <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap [Edge])
pvec
Ref m (MVector (PrimState m) (IntMap [Edge]))
sref <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap [Edge])
svec
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! MBiDigraph { mgraphVertexCount :: Ref m Int
mgraphVertexCount = Ref m Int
nn
, mgraphEdgeCount :: Ref m Int
mgraphEdgeCount = Ref m Int
en
, mgraphEdgeIdSrc :: Ref m Int
mgraphEdgeIdSrc = Ref m Int
esrc
, mgraphPreds :: Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds = Ref m (MVector (PrimState m) (IntMap [Edge]))
pref
, mgraphSuccs :: Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs = Ref m (MVector (PrimState m) (IntMap [Edge]))
sref
}
instance MGraph MBiDigraph where
type ImmutableGraph MBiDigraph = BiDigraph
getVertices :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m [Vertex]
getVertices MBiDigraph m
g = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
forall (m :: * -> *) a. Monad m => a -> m a
return [ Int -> Vertex
V Int
v | Int
v <- [Int
0.. Int
nVerts forall a. Num a => a -> a -> a
- Int
1] ]
getOutEdges :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> m [Edge]
getOutEdges MBiDigraph m
g (V Int
src) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
src forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
False -> do
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
IntMap [Edge]
succs <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
svec Int
src
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. IntMap a -> [a]
IM.elems IntMap [Edge]
succs)
countVertices :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m Int
countVertices = forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount
countEdges :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m Int
countEdges = forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeCount
getSuccessors :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> m [Vertex]
getSuccessors MBiDigraph m
g (V Int
src) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
src forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
False -> do
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
IntMap [Edge]
succs <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
svec Int
src
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [Int]
IM.keys IntMap [Edge]
succs
checkEdgeExists :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> Vertex -> m Bool
checkEdgeExists MBiDigraph m
g (V Int
src) (V Int
dst) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
src forall a. Ord a => a -> a -> Bool
>= Int
nVerts Bool -> Bool -> Bool
|| Int
dst forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool
False -> do
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
IntMap [Edge]
succs <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
svec Int
src
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Bool
IM.member Int
dst IntMap [Edge]
succs
freeze :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m (ImmutableGraph MBiDigraph)
freeze MBiDigraph m
g = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
Int
nEdges <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeCount MBiDigraph m
g)
Int
esrc <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeIdSrc MBiDigraph m
g)
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
Vector (IntMap [Edge])
pvec' <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (forall s a. Int -> MVector s a -> MVector s a
MV.take Int
nVerts MVector (PrimState m) (IntMap [Edge])
pvec)
Vector (IntMap [Edge])
svec' <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze (forall s a. Int -> MVector s a -> MVector s a
MV.take Int
nVerts MVector (PrimState m) (IntMap [Edge])
svec)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! BiDigraph { vertexCount :: Int
vertexCount = Int
nVerts
, edgeCount :: Int
edgeCount = Int
nEdges
, edgeIdSrc :: Int
edgeIdSrc = Int
esrc
, graphPreds :: Vector (IntMap [Edge])
graphPreds = Vector (IntMap [Edge])
pvec'
, graphSuccs :: Vector (IntMap [Edge])
graphSuccs = Vector (IntMap [Edge])
svec'
}
instance MAddVertex MBiDigraph where
addVertex :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m Vertex
addVertex MBiDigraph m
g = do
forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m ()
ensureNodeSpace MBiDigraph m
g
Int
vid <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef Ref m Int
r
forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' Ref m Int
r (forall a. Num a => a -> a -> a
+Int
1)
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) (IntMap [Edge])
pvec Int
vid forall a. IntMap a
IM.empty
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) (IntMap [Edge])
svec Int
vid forall a. IntMap a
IM.empty
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Vertex
V Int
vid)
where
r :: Ref m Int
r = forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g
instance MAddEdge MBiDigraph where
addEdge :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge MBiDigraph m
g (V Int
src) (V Int
dst) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
src forall a. Ord a => a -> a -> Bool
>= Int
nVerts Bool -> Bool -> Bool
|| Int
dst forall a. Ord a => a -> a -> Bool
>= Int
nVerts of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Bool
False -> do
Int
eid <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeIdSrc MBiDigraph m
g)
forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeIdSrc MBiDigraph m
g) (forall a. Num a => a -> a -> a
+Int
1)
forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphEdgeCount MBiDigraph m
g) (forall a. Num a => a -> a -> a
+Int
1)
let e :: Edge
e = Int -> Int -> Int -> Edge
E Int
eid Int
src Int
dst
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
IntMap [Edge]
preds <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
pvec Int
dst
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector (PrimState m) (IntMap [Edge])
pvec Int
dst (forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
(++) Int
src [Edge
e] IntMap [Edge]
preds)
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
IntMap [Edge]
succs <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
svec Int
src
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector (PrimState m) (IntMap [Edge])
svec Int
src (forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith forall a. [a] -> [a] -> [a]
(++) Int
dst [Edge
e] IntMap [Edge]
succs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Edge
e
instance MBidirectional MBiDigraph where
getPredecessors :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> m [Vertex]
getPredecessors MBiDigraph m
g (V Int
vid) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
vid forall a. Ord a => a -> a -> Bool
< Int
nVerts of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
True -> do
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
IntMap [Edge]
preds <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
pvec Int
vid
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [Int]
IM.keys IntMap [Edge]
preds
getInEdges :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> Vertex -> m [Edge]
getInEdges MBiDigraph m
g (V Int
vid) = do
Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
vid forall a. Ord a => a -> a -> Bool
< Int
nVerts of
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Bool
True -> do
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
IntMap [Edge]
preds <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector (PrimState m) (IntMap [Edge])
pvec Int
vid
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. IntMap a -> [a]
IM.elems IntMap [Edge]
preds)
instance Thawable BiDigraph where
type MutableGraph BiDigraph = MBiDigraph
thaw :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
BiDigraph -> m (MutableGraph BiDigraph m)
thaw BiDigraph
g = do
Ref m Int
vc <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (BiDigraph -> Int
vertexCount BiDigraph
g)
Ref m Int
ec <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (BiDigraph -> Int
edgeCount BiDigraph
g)
Ref m Int
eidsrc <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (BiDigraph -> Int
edgeIdSrc BiDigraph
g)
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (BiDigraph -> Vector (IntMap [Edge])
graphPreds BiDigraph
g)
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (BiDigraph -> Vector (IntMap [Edge])
graphSuccs BiDigraph
g)
Ref m (MVector (PrimState m) (IntMap [Edge]))
pref <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap [Edge])
pvec
Ref m (MVector (PrimState m) (IntMap [Edge]))
sref <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef MVector (PrimState m) (IntMap [Edge])
svec
forall (m :: * -> *) a. Monad m => a -> m a
return MBiDigraph { mgraphVertexCount :: Ref m Int
mgraphVertexCount = Ref m Int
vc
, mgraphEdgeCount :: Ref m Int
mgraphEdgeCount = Ref m Int
ec
, mgraphEdgeIdSrc :: Ref m Int
mgraphEdgeIdSrc = Ref m Int
eidsrc
, mgraphPreds :: Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds = Ref m (MVector (PrimState m) (IntMap [Edge]))
pref
, mgraphSuccs :: Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs = Ref m (MVector (PrimState m) (IntMap [Edge]))
sref
}
instance Graph BiDigraph where
vertices :: BiDigraph -> [Vertex]
vertices BiDigraph
g = forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V [Int
0 .. BiDigraph -> Int
vertexCount BiDigraph
g forall a. Num a => a -> a -> a
- Int
1]
edges :: BiDigraph -> [Edge]
edges BiDigraph
g = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall g. Graph g => g -> Vertex -> [Edge]
outEdges BiDigraph
g) (forall g. Graph g => g -> [Vertex]
vertices BiDigraph
g)
successors :: BiDigraph -> Vertex -> [Vertex]
successors BiDigraph
g (V Int
v)
| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
v = []
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [Int]
IM.keys forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> a
V.unsafeIndex (BiDigraph -> Vector (IntMap [Edge])
graphSuccs BiDigraph
g) Int
v
outEdges :: BiDigraph -> Vertex -> [Edge]
outEdges BiDigraph
g (V Int
v)
| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
v = []
| Bool
otherwise =
let succs :: IntMap [Edge]
succs = forall a. Vector a -> Int -> a
V.unsafeIndex (BiDigraph -> Vector (IntMap [Edge])
graphSuccs BiDigraph
g) Int
v
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. IntMap a -> [a]
IM.elems IntMap [Edge]
succs)
edgesBetween :: BiDigraph -> Vertex -> Vertex -> [Edge]
edgesBetween BiDigraph
g (V Int
src) (V Int
dst)
| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
src Bool -> Bool -> Bool
|| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
dst = []
| Bool
otherwise = forall a. a -> Int -> IntMap a -> a
IM.findWithDefault [] Int
dst (forall a. Vector a -> Int -> a
V.unsafeIndex (BiDigraph -> Vector (IntMap [Edge])
graphSuccs BiDigraph
g) Int
src)
maxVertexId :: BiDigraph -> Int
maxVertexId BiDigraph
g = forall a. Vector a -> Int
V.length (BiDigraph -> Vector (IntMap [Edge])
graphSuccs BiDigraph
g) forall a. Num a => a -> a -> a
- Int
1
isEmpty :: BiDigraph -> Bool
isEmpty = (forall a. Eq a => a -> a -> Bool
==Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BiDigraph -> Int
vertexCount
instance Bidirectional BiDigraph where
predecessors :: BiDigraph -> Vertex -> [Vertex]
predecessors BiDigraph
g (V Int
v)
| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
v = []
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V forall a b. (a -> b) -> a -> b
$ forall a. IntMap a -> [Int]
IM.keys forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int -> a
V.unsafeIndex (BiDigraph -> Vector (IntMap [Edge])
graphPreds BiDigraph
g) Int
v
inEdges :: BiDigraph -> Vertex -> [Edge]
inEdges BiDigraph
g (V Int
v)
| BiDigraph -> Int -> Bool
outOfRange BiDigraph
g Int
v = []
| Bool
otherwise =
let preds :: IntMap [Edge]
preds = forall a. Vector a -> Int -> a
V.unsafeIndex (BiDigraph -> Vector (IntMap [Edge])
graphPreds BiDigraph
g) Int
v
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a. IntMap a -> [a]
IM.elems IntMap [Edge]
preds)
outOfRange :: BiDigraph -> Int -> Bool
outOfRange :: BiDigraph -> Int -> Bool
outOfRange BiDigraph
g = (forall a. Ord a => a -> a -> Bool
>= BiDigraph -> Int
vertexCount BiDigraph
g)
ensureNodeSpace :: (P.PrimMonad m, R.MonadRef m) => MBiDigraph m -> m ()
ensureNodeSpace :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MBiDigraph m -> m ()
ensureNodeSpace MBiDigraph m
g = do
MVector (PrimState m) (IntMap [Edge])
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g)
MVector (PrimState m) (IntMap [Edge])
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g)
let cap :: Int
cap = forall s a. MVector s a -> Int
MV.length MVector (PrimState m) (IntMap [Edge])
pvec
Int
cnt <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MBiDigraph m -> Ref m Int
mgraphVertexCount MBiDigraph m
g)
case Int
cnt forall a. Ord a => a -> a -> Bool
< Int
cap of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
MVector (PrimState m) (IntMap [Edge])
pvec' <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) (IntMap [Edge])
pvec Int
cap
MVector (PrimState m) (IntMap [Edge])
svec' <- forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
MV.grow MVector (PrimState m) (IntMap [Edge])
svec Int
cap
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphPreds MBiDigraph m
g) MVector (PrimState m) (IntMap [Edge])
pvec'
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (forall (m :: * -> *).
MBiDigraph m -> Ref m (MVector (PrimState m) (IntMap [Edge]))
mgraphSuccs MBiDigraph m
g) MVector (PrimState m) (IntMap [Edge])
svec'