{-# LANGUAGE TypeFamilies #-}
-- | This graph is an efficient representation of bidirectional graphs with
-- parallel edges.
--
-- This is in contrast to 'Data.Graph.Haggle.SimpleBiDigraph', which
-- can only handle simple graphs (i.e., without parallel edges).
--
-- The representation is slightly less efficient as a result.
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

-- | A mutable bidirectional graph
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]))
             }

-- | An immutable bidirectional graph
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

-- | Allocate a new mutable bidirectional graph with a default size
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

-- | Allocate a new mutable bidirectional graph with space reserved
-- for nodes and edges.  This can be more efficient and avoid resizing.
newSizedMBiDigraph :: (P.PrimMonad m, R.MonadRef m)
                   => Int -- ^ Reserved space for nodes
                   -> Int -- ^ Reserved space for edges
                   -> 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)

-- Helpers

outOfRange :: BiDigraph -> Int -> Bool
outOfRange :: BiDigraph -> Int -> Bool
outOfRange BiDigraph
g = (forall a. Ord a => a -> a -> Bool
>= BiDigraph -> Int
vertexCount BiDigraph
g)

-- | Given a graph, ensure that there is space in the vertex vector
-- for a new vertex.  If there is not, double the capacity.
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'