{-# LANGUAGE TypeFamilies #-}
-- | This is a simple graph (it does not allow parallel edges).  To support
-- this efficiently, it is less compact than 'Digraph' or 'BiDigraph'.  As
-- a consequence, edge existence tests are efficient (logarithmic in the
-- number of edges leaving the source vertex).
module Data.Graph.Haggle.SimpleBiDigraph (
  MSimpleBiDigraph,
  SimpleBiDigraph,
  newMSimpleBiDigraph,
  newSizedMSimpleBiDigraph
  ) where

import qualified Control.DeepSeq as DS
import Control.Monad ( when )
import qualified Control.Monad.Primitive as P
import qualified Control.Monad.Ref as R
import Data.Foldable ( toList )
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 MSimpleBiDigraph m = -- See Note [Graph Representation]
  MBiDigraph { forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount :: R.Ref m Int
             , forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount :: R.Ref m Int
             , forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
             , forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs :: R.Ref m (MV.MVector (P.PrimState m) (IntMap Edge))
             }

data SimpleBiDigraph =
  BiDigraph { SimpleBiDigraph -> Int
vertexCount :: {-# UNPACK #-} !Int
            , SimpleBiDigraph -> Int
edgeCount :: {-# UNPACK #-} !Int
            , SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds :: V.Vector (IntMap Edge)
            , SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs :: V.Vector (IntMap Edge)
            }

instance DS.NFData SimpleBiDigraph where
  rnf :: SimpleBiDigraph -> ()
rnf SimpleBiDigraph
bdg = SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
bdg forall a b. NFData a => a -> b -> b
`DS.deepseq` SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
bdg forall a b. NFData a => a -> b -> b
`DS.deepseq` ()

defaultSize :: Int
defaultSize :: Int
defaultSize = Int
128

newMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => m (MSimpleBiDigraph m)
newMSimpleBiDigraph :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
m (MSimpleBiDigraph m)
newMSimpleBiDigraph = forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph Int
defaultSize Int
0

newSizedMSimpleBiDigraph :: (P.PrimMonad m, R.MonadRef m) => Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
Int -> Int -> m (MSimpleBiDigraph m)
newSizedMSimpleBiDigraph 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]
"Negative size (newSized)"
  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
  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
                       , 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 MSimpleBiDigraph where
  type ImmutableGraph MSimpleBiDigraph = SimpleBiDigraph
  getVertices :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> m [Vertex]
getVertices MSimpleBiDigraph m
g = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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) =>
MSimpleBiDigraph m -> Vertex -> m [Edge]
getOutEdges MSimpleBiDigraph m
g (V Int
src) = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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. IntMap a -> [a]
IM.elems IntMap Edge
succs

  countVertices :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount
  countEdges :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount

  getSuccessors :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> Vertex -> m [Vertex]
getSuccessors MSimpleBiDigraph m
g (V Int
src) = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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) =>
MSimpleBiDigraph m -> Vertex -> Vertex -> m Bool
checkEdgeExists MSimpleBiDigraph 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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) =>
MSimpleBiDigraph m -> m (ImmutableGraph MSimpleBiDigraph)
freeze MSimpleBiDigraph m
g = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    Int
nEdges <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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
                        , graphPreds :: Vector (IntMap Edge)
graphPreds = Vector (IntMap Edge)
pvec'
                        , graphSuccs :: Vector (IntMap Edge)
graphSuccs = Vector (IntMap Edge)
svec'
                        }

instance MAddVertex MSimpleBiDigraph where
  addVertex :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> m Vertex
addVertex MSimpleBiDigraph m
g = do
    forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> m ()
ensureNodeSpace MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
    MVector (PrimState m) (IntMap Edge)
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g

instance MAddEdge MSimpleBiDigraph where
  addEdge :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> Vertex -> Vertex -> m (Maybe Edge)
addEdge MSimpleBiDigraph m
g v1 :: Vertex
v1@(V Int
src) v2 :: Vertex
v2@(V Int
dst) = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph m
g)
    Bool
exists <- forall (g :: (* -> *) -> *) (m :: * -> *).
(MGraph g, PrimMonad m, MonadRef m) =>
g m -> Vertex -> Vertex -> m Bool
checkEdgeExists MSimpleBiDigraph m
g Vertex
v1 Vertex
v2
    case Bool
exists Bool -> Bool -> Bool
|| 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g)
        let e :: Edge
e = Int -> Int -> Int -> Edge
E Int
eid Int
src Int
dst
        forall (m :: * -> *) a. MonadRef m => Ref m a -> (a -> a) -> m ()
R.modifyRef' (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphEdgeCount MSimpleBiDigraph m
g) (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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph 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. Int -> a -> IntMap a -> IntMap a
IM.insert 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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. Int -> a -> IntMap a -> IntMap a
IM.insert 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 MSimpleBiDigraph where
  getPredecessors :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> Vertex -> m [Vertex]
getPredecessors MSimpleBiDigraph m
g (V Int
vid) = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph 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) =>
MSimpleBiDigraph m -> Vertex -> m [Edge]
getInEdges MSimpleBiDigraph m
g (V Int
vid) = do
    Int
nVerts <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph 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. IntMap a -> [a]
IM.elems IntMap Edge
preds

instance Thawable SimpleBiDigraph where
  type MutableGraph SimpleBiDigraph = MSimpleBiDigraph
  thaw :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
SimpleBiDigraph -> m (MutableGraph SimpleBiDigraph m)
thaw SimpleBiDigraph
g = do
    Ref m Int
vc <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
g)
    Ref m Int
ec <- forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
R.newRef (SimpleBiDigraph -> Int
edgeCount SimpleBiDigraph
g)
    MVector (PrimState m) (IntMap Edge)
pvec <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g)
    MVector (PrimState m) (IntMap Edge)
svec <- forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.thaw (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
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
                      , 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 SimpleBiDigraph where
  -- FIXME: This will be more complicated if we support removing vertices
  vertices :: SimpleBiDigraph -> [Vertex]
vertices SimpleBiDigraph
g = forall a b. (a -> b) -> [a] -> [b]
map Int -> Vertex
V [Int
0 .. SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
g forall a. Num a => a -> a -> a
- Int
1]
  edges :: SimpleBiDigraph -> [Edge]
edges SimpleBiDigraph
g = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall g. Graph g => g -> Vertex -> [Edge]
outEdges SimpleBiDigraph
g) (forall g. Graph g => g -> [Vertex]
vertices SimpleBiDigraph
g)
  successors :: SimpleBiDigraph -> Vertex -> [Vertex]
successors SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
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 (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
v
  outEdges :: SimpleBiDigraph -> Vertex -> [Edge]
outEdges SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise =
      let succs :: IntMap Edge
succs = forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
v
      in forall a. IntMap a -> [a]
IM.elems IntMap Edge
succs
  edgesBetween :: SimpleBiDigraph -> Vertex -> Vertex -> [Edge]
edgesBetween SimpleBiDigraph
g (V Int
src) (V Int
dst)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
src Bool -> Bool -> Bool
|| SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
dst = []
    | Bool
otherwise = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
dst (forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) Int
src)
  maxVertexId :: SimpleBiDigraph -> Int
maxVertexId SimpleBiDigraph
g = forall a. Vector a -> Int
V.length (SimpleBiDigraph -> Vector (IntMap Edge)
graphSuccs SimpleBiDigraph
g) forall a. Num a => a -> a -> a
- Int
1
  isEmpty :: SimpleBiDigraph -> Bool
isEmpty = (forall a. Eq a => a -> a -> Bool
==Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleBiDigraph -> Int
vertexCount


instance Bidirectional SimpleBiDigraph  where
  predecessors :: SimpleBiDigraph -> Vertex -> [Vertex]
predecessors SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
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 (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g) Int
v
  inEdges :: SimpleBiDigraph -> Vertex -> [Edge]
inEdges SimpleBiDigraph
g (V Int
v)
    | SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g Int
v = []
    | Bool
otherwise =
      let preds :: IntMap Edge
preds = forall a. Vector a -> Int -> a
V.unsafeIndex (SimpleBiDigraph -> Vector (IntMap Edge)
graphPreds SimpleBiDigraph
g) Int
v
      in forall a. IntMap a -> [a]
IM.elems IntMap Edge
preds

-- Helpers

outOfRange :: SimpleBiDigraph -> Int -> Bool
outOfRange :: SimpleBiDigraph -> Int -> Bool
outOfRange SimpleBiDigraph
g = (forall a. Ord a => a -> a -> Bool
>= SimpleBiDigraph -> Int
vertexCount SimpleBiDigraph
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) => MSimpleBiDigraph m -> m ()
ensureNodeSpace :: forall (m :: * -> *).
(PrimMonad m, MonadRef m) =>
MSimpleBiDigraph m -> m ()
ensureNodeSpace MSimpleBiDigraph m
g = do
  MVector (PrimState m) (IntMap Edge)
pvec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g)
  MVector (PrimState m) (IntMap Edge)
svec <- forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
R.readRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph 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 :: * -> *). MSimpleBiDigraph m -> Ref m Int
mgraphVertexCount MSimpleBiDigraph 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 :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphPreds MSimpleBiDigraph m
g) MVector (PrimState m) (IntMap Edge)
pvec'
      forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
R.writeRef (forall (m :: * -> *).
MSimpleBiDigraph m -> Ref m (MVector (PrimState m) (IntMap Edge))
mgraphSuccs MSimpleBiDigraph m
g) MVector (PrimState m) (IntMap Edge)
svec'


{- Note [Graph Representation]

Each of the IntMaps in the vectors maps the edge *destination* node id to the
*edge id*.  We need to store the edge IDs to reconstruct an Edge.  Other graph
representations use the edge IDs to maintain lists, but here we don't have
that.  The destination is the key of the map for fast edgeExists tests.

-}