{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./Common/Lib/Graph.hs
Description :  Tree-based implementation of 'Graph' and 'DynGraph'
  using Data.Map
Copyright   :  (c) Martin Erwig, Christian Maeder and Uni Bremen 1999-2006
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Tree-based implementation of 'Graph' and 'DynGraph' using Data.IntMap
instead of Data.Graph.Inductive.Internal.FiniteMap
-}

module Common.Lib.Graph
  ( Gr (..)
  , GrContext (..)
  , unsafeConstructGr
  , decomposeGr
  , getPaths
  , getAllPathsTo
  , getPathsTo
  , getLEdges
  , Common.Lib.Graph.delLEdge
  , insLEdge
  , delLNode
  , labelNode
  , getNewNode
  , rmIsolated
  ) where

import Data.Graph.Inductive.Graph as Graph

import Data.Data
import Data.List
import qualified Data.IntMap as Map

-- | the graph type constructor
newtype Gr a b = Gr { Gr a b -> IntMap (GrContext a b)
convertToMap :: Map.IntMap (GrContext a b) }
  deriving (Typeable, Typeable (Gr a b)
Constr
DataType
Typeable (Gr a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Gr a b -> c (Gr a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Gr a b))
-> (Gr a b -> Constr)
-> (Gr a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Gr a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b)))
-> ((forall b. Data b => b -> b) -> Gr a b -> Gr a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Gr a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Gr a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> Gr a b -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Gr a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b))
-> Data (Gr a b)
Gr a b -> Constr
Gr a b -> DataType
(forall b. Data b => b -> b) -> Gr a b -> Gr a b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Gr a b -> c (Gr a b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Gr a b)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Gr a b -> u
forall u. (forall d. Data d => d -> u) -> Gr a b -> [u]
forall a b. (Data a, Data b) => Typeable (Gr a b)
forall a b. (Data a, Data b) => Gr a b -> Constr
forall a b. (Data a, Data b) => Gr a b -> DataType
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Gr a b -> Gr a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Gr a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Gr a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Gr a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Gr a b -> c (Gr a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Gr a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b))
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Gr a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Gr a b -> c (Gr a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Gr a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b))
$cGr :: Constr
$tGr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
gmapMp :: (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
gmapM :: (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Gr a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Gr a b -> u
gmapQ :: (forall d. Data d => d -> u) -> Gr a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Gr a b -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r
gmapT :: (forall b. Data b => b -> b) -> Gr a b -> Gr a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Gr a b -> Gr a b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Gr a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Gr a b))
dataTypeOf :: Gr a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Gr a b -> DataType
toConstr :: Gr a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Gr a b -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Gr a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Gr a b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Gr a b -> c (Gr a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Gr a b -> c (Gr a b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (Gr a b)
Data)

data GrContext a b = GrContext
    { GrContext a b -> a
nodeLabel :: a
    , GrContext a b -> IntMap [b]
nodeSuccs :: Map.IntMap [b]
    , GrContext a b -> [b]
loops :: [b]
    , GrContext a b -> IntMap [b]
nodePreds :: Map.IntMap [b] }
  deriving (Typeable, Typeable (GrContext a b)
Constr
DataType
Typeable (GrContext a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GrContext a b))
-> (GrContext a b -> Constr)
-> (GrContext a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (GrContext a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (GrContext a b)))
-> ((forall b. Data b => b -> b) -> GrContext a b -> GrContext a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GrContext a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GrContext a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> GrContext a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GrContext a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GrContext a b -> m (GrContext a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GrContext a b -> m (GrContext a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GrContext a b -> m (GrContext a b))
-> Data (GrContext a b)
GrContext a b -> Constr
GrContext a b -> DataType
(forall b. Data b => b -> b) -> GrContext a b -> GrContext a b
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GrContext a b)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GrContext a b))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GrContext a b -> u
forall u. (forall d. Data d => d -> u) -> GrContext a b -> [u]
forall a b. (Data a, Data b) => Typeable (GrContext a b)
forall a b. (Data a, Data b) => GrContext a b -> Constr
forall a b. (Data a, Data b) => GrContext a b -> DataType
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> GrContext a b -> GrContext a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> GrContext a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> GrContext a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GrContext a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GrContext a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GrContext a b))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GrContext a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GrContext a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GrContext a b))
$cGrContext :: Constr
$tGrContext :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
gmapMp :: (forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
gmapM :: (forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d)
-> GrContext a b -> m (GrContext a b)
gmapQi :: Int -> (forall d. Data d => d -> u) -> GrContext a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> GrContext a b -> u
gmapQ :: (forall d. Data d => d -> u) -> GrContext a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> GrContext a b -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GrContext a b -> r
gmapT :: (forall b. Data b => b -> b) -> GrContext a b -> GrContext a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> GrContext a b -> GrContext a b
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GrContext a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GrContext a b))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (GrContext a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GrContext a b))
dataTypeOf :: GrContext a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => GrContext a b -> DataType
toConstr :: GrContext a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => GrContext a b -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GrContext a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GrContext a b)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GrContext a b -> c (GrContext a b)
$cp1Data :: forall a b. (Data a, Data b) => Typeable (GrContext a b)
Data)

unsafeConstructGr :: Map.IntMap (GrContext a b) -> Gr a b
unsafeConstructGr :: IntMap (GrContext a b) -> Gr a b
unsafeConstructGr = IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr

instance (Show a, Show b) => Show (Gr a b) where
  show :: Gr a b -> String
show (Gr g :: IntMap (GrContext a b)
g) = IntMap (GrContext a b) -> String
forall a b. (Show a, Show b) => IntMap (GrContext a b) -> String
showGraph IntMap (GrContext a b)
g

instance Graph Gr where
  empty :: Gr a b
empty = IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr IntMap (GrContext a b)
forall a. IntMap a
Map.empty
  isEmpty :: Gr a b -> Bool
isEmpty (Gr g :: IntMap (GrContext a b)
g) = IntMap (GrContext a b) -> Bool
forall a. IntMap a -> Bool
Map.null IntMap (GrContext a b)
g
  match :: 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 :: [LNode a] -> [LEdge b] -> Gr a b
mkGraph vs :: [LNode a]
vs es :: [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) -> (Gr a b -> Gr a b) -> Gr a b -> Gr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LNode a] -> Gr a b -> Gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
vs) Gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
  labNodes :: Gr a b -> [LNode a]
labNodes = ((Int, GrContext a b) -> LNode a)
-> [(Int, GrContext a b)] -> [LNode a]
forall a b. (a -> b) -> [a] -> [b]
map (\ (v :: Int
v, c :: GrContext a b
c) -> (Int
v, GrContext a b -> a
forall a b. GrContext a b -> a
nodeLabel GrContext a b
c)) ([(Int, GrContext a b)] -> [LNode a])
-> (Gr a b -> [(Int, GrContext a b)]) -> Gr a b -> [LNode a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (GrContext a b) -> [(Int, GrContext a b)]
forall a. IntMap a -> [(Int, a)]
Map.toList (IntMap (GrContext a b) -> [(Int, GrContext a b)])
-> (Gr a b -> IntMap (GrContext a b))
-> Gr a b
-> [(Int, GrContext a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr a b -> IntMap (GrContext a b)
forall a b. Gr a b -> IntMap (GrContext a b)
convertToMap
  -- more efficient versions of derived class members
  matchAny :: Gr a b -> GDecomp Gr a b
matchAny g :: Gr a b
g = case IntMap (GrContext a b) -> [Int]
forall a. IntMap a -> [Int]
Map.keys (IntMap (GrContext a b) -> [Int])
-> IntMap (GrContext a b) -> [Int]
forall a b. (a -> b) -> a -> b
$ Gr a b -> IntMap (GrContext a b)
forall a b. Gr a b -> IntMap (GrContext a b)
convertToMap Gr a b
g of
    [] -> String -> GDecomp Gr a b
forall a. HasCallStack => String -> a
error "Match Exception, Empty Graph"
    h :: Int
h : _ -> let (Just c :: Context a b
c, g' :: Gr a b
g') = Int -> Gr a b -> (Maybe (Context a b), Gr a b)
forall a b. Int -> Gr a b -> Decomp Gr a b
matchGr Int
h Gr a b
g in (Context a b
c, Gr a b
g')
  noNodes :: Gr a b -> Int
noNodes (Gr g :: IntMap (GrContext a b)
g) = IntMap (GrContext a b) -> Int
forall a. IntMap a -> Int
Map.size IntMap (GrContext a b)
g
  nodeRange :: Gr a b -> (Int, Int)
nodeRange (Gr g :: IntMap (GrContext a b)
g) = case IntMap (GrContext a b) -> [Int]
forall a. IntMap a -> [Int]
Map.keys IntMap (GrContext a b)
g of
    [] -> (0, -1)
    ks :: [Int]
ks@(h :: Int
h : _) -> (Int
h, [Int] -> Int
forall a. [a] -> a
last [Int]
ks)
  labEdges :: Gr a b -> [LEdge b]
labEdges =
    ((Int, GrContext a b) -> [LEdge b])
-> [(Int, GrContext a b)] -> [LEdge b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (v :: Int
v, cw :: GrContext a b
cw) -> ((b, Int) -> LEdge b) -> [(b, Int)] -> [LEdge b]
forall a b. (a -> b) -> [a] -> [b]
map (\ (l :: b
l, w :: Int
w) -> (Int
v, Int
w, b
l))
              ([(b, Int)] -> [LEdge b]) -> [(b, Int)] -> [LEdge b]
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> [(b, Int)]
forall b. Int -> [b] -> Adj b
mkLoops Int
v (GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
cw) [(b, Int)] -> [(b, Int)] -> [(b, Int)]
forall a. [a] -> [a] -> [a]
++ IntMap [b] -> [(b, Int)]
forall b. IntMap [b] -> Adj b
mkAdj (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
cw))
    ([(Int, GrContext a b)] -> [LEdge b])
-> (Gr a b -> [(Int, GrContext a b)]) -> Gr a b -> [LEdge b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (GrContext a b) -> [(Int, GrContext a b)]
forall a. IntMap a -> [(Int, a)]
Map.toList (IntMap (GrContext a b) -> [(Int, GrContext a b)])
-> (Gr a b -> IntMap (GrContext a b))
-> Gr a b
-> [(Int, GrContext a b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gr a b -> IntMap (GrContext a b)
forall a b. Gr a b -> IntMap (GrContext a b)
convertToMap

instance DynGraph Gr where
  (p :: Adj b
p, v :: Int
v, l :: a
l, s :: Adj b
s) & :: Context a b -> Gr a b -> Gr a b
& gr :: Gr a b
gr = let
    mkMap :: [(a, Int)] -> IntMap [a]
mkMap = ((a, Int) -> IntMap [a] -> IntMap [a])
-> IntMap [a] -> [(a, Int)] -> IntMap [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (e :: a
e, w :: Int
w) -> ([a] -> [a] -> [a]) -> Int -> [a] -> IntMap [a] -> IntMap [a]
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Int
w [a
e]) IntMap [a]
forall a. IntMap a
Map.empty
    pm :: IntMap [b]
pm = Adj b -> IntMap [b]
forall a. [(a, Int)] -> IntMap [a]
mkMap Adj b
p
    sm :: IntMap [b]
sm = Adj b -> IntMap [b]
forall a. [(a, Int)] -> IntMap [a]
mkMap Adj b
s
    in Int -> GrContext a b -> Gr a b -> Gr a b
forall a b. Int -> GrContext a b -> Gr a b -> Gr a b
composeGr Int
v GrContext :: forall a b. a -> IntMap [b] -> [b] -> IntMap [b] -> GrContext a b
GrContext
      { nodeLabel :: a
nodeLabel = a
l
      , nodeSuccs :: IntMap [b]
nodeSuccs = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v IntMap [b]
sm
      , loops :: [b]
loops = [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault [] Int
v IntMap [b]
pm [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault [] Int
v IntMap [b]
sm
      , nodePreds :: IntMap [b]
nodePreds = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v IntMap [b]
pm } Gr a b
gr

showGraph :: (Show a, Show b) => Map.IntMap (GrContext a b) -> String
showGraph :: IntMap (GrContext a b) -> String
showGraph = [String] -> String
unlines ([String] -> String)
-> (IntMap (GrContext a b) -> [String])
-> IntMap (GrContext a b)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GrContext a b) -> String)
-> [(Int, GrContext a b)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
  (\ (v :: Int
v, c :: GrContext a b
c) ->
   Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
v ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (GrContext a b -> a
forall a b. GrContext a b -> a
nodeLabel GrContext a b
c)
   String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Int, [b])] -> String
forall b. Show b => [(Int, [b])] -> String
showLinks
   ((case GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c of
       [] -> []
       l :: [b]
l -> [(Int
v, [b]
l)]) [(Int, [b])] -> [(Int, [b])] -> [(Int, [b])]
forall a. [a] -> [a] -> [a]
++ IntMap [b] -> [(Int, [b])]
forall a. IntMap a -> [(Int, a)]
Map.toList (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c)))
  ([(Int, GrContext a b)] -> [String])
-> (IntMap (GrContext a b) -> [(Int, GrContext a b)])
-> IntMap (GrContext a b)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (GrContext a b) -> [(Int, GrContext a b)]
forall a. IntMap a -> [(Int, a)]
Map.toList

showLinks :: Show b => [(Node, [b])] -> String
showLinks :: [(Int, [b])] -> String
showLinks = ((Int, [b]) -> String) -> [(Int, [b])] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Int, [b]) -> String) -> [(Int, [b])] -> String)
-> ((Int, [b]) -> String) -> [(Int, [b])] -> String
forall a b. (a -> b) -> a -> b
$ \ (v :: Int
v, l :: [b]
l) -> " - " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((b -> String) -> [b] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map b -> String
forall a. Show a => a -> String
show [b]
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
v ";"

mkLoops :: Node -> [b] -> Adj b
mkLoops :: Int -> [b] -> Adj b
mkLoops v :: Int
v = (b -> (b, Int)) -> [b] -> Adj b
forall a b. (a -> b) -> [a] -> [b]
map (\ e :: b
e -> (b
e, Int
v))

mkAdj :: Map.IntMap [b] -> Adj b
mkAdj :: IntMap [b] -> Adj b
mkAdj = ((Int, [b]) -> Adj b) -> [(Int, [b])] -> Adj b
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (w :: Int
w, l :: [b]
l) -> (b -> (b, Int)) -> [b] -> Adj b
forall a b. (a -> b) -> [a] -> [b]
map (\ e :: b
e -> (b
e, Int
w)) [b]
l) ([(Int, [b])] -> Adj b)
-> (IntMap [b] -> [(Int, [b])]) -> IntMap [b] -> Adj b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [b] -> [(Int, [b])]
forall a. IntMap a -> [(Int, a)]
Map.toList

{- here cyclic edges are omitted as predecessors, thus they only count
as outgoing and not as ingoing! Therefore it is enough that only
successors are filtered during deletions. -}
matchGr :: Node -> Gr a b -> Decomp Gr a b
matchGr :: Int -> Gr a b -> Decomp Gr a b
matchGr v :: Int
v gr :: Gr a b
gr = case Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
forall a b. Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr Int
v Gr a b
gr of
  Nothing -> (Maybe (Context a b)
forall a. Maybe a
Nothing, Gr a b
gr)
  Just (c :: GrContext a b
c, rg :: Gr a b
rg) -> (Context a b -> Maybe (Context a b)
forall a. a -> Maybe a
Just ( IntMap [b] -> Adj b
forall b. IntMap [b] -> Adj b
mkAdj (IntMap [b] -> Adj b) -> IntMap [b] -> Adj b
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c , Int
v , GrContext a b -> a
forall a b. GrContext a b -> a
nodeLabel GrContext a b
c
                        , Int -> [b] -> Adj b
forall b. Int -> [b] -> Adj b
mkLoops Int
v (GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c) Adj b -> Adj b -> Adj b
forall a. [a] -> [a] -> [a]
++ IntMap [b] -> Adj b
forall b. IntMap [b] -> Adj b
mkAdj (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c)), Gr a b
rg)

decomposeGr :: Node -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr :: Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr v :: Int
v (Gr g :: IntMap (GrContext a b)
g) = case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
g of
  Nothing -> Maybe (GrContext a b, Gr a b)
forall a. Maybe a
Nothing
  Just c :: GrContext a b
c -> let
    g1 :: IntMap (GrContext a b)
g1 = Int -> IntMap (GrContext a b) -> IntMap (GrContext a b)
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v IntMap (GrContext a b)
g
    g2 :: IntMap (GrContext a b)
g2 = IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b.
IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
updAdj IntMap (GrContext a b)
g1 (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c) (([b] -> GrContext a b -> GrContext a b) -> IntMap (GrContext a b))
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
clearPred Int
v
    g3 :: IntMap (GrContext a b)
g3 = IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b.
IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
updAdj IntMap (GrContext a b)
g2 (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c) (([b] -> GrContext a b -> GrContext a b) -> IntMap (GrContext a b))
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
clearSucc Int
v
    in (GrContext a b, Gr a b) -> Maybe (GrContext a b, Gr a b)
forall a. a -> Maybe a
Just (GrContext a b
c, IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr IntMap (GrContext a b)
g3)

addSuccs :: Node -> [b] -> GrContext a b -> GrContext a b
addSuccs :: Int -> [b] -> GrContext a b -> GrContext a b
addSuccs v :: Int
v ls :: [b]
ls c :: GrContext a b
c = GrContext a b
c { nodeSuccs :: IntMap [b]
nodeSuccs = Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v [b]
ls (IntMap [b] -> IntMap [b]) -> IntMap [b] -> IntMap [b]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c }

addPreds :: Node -> [b] -> GrContext a b -> GrContext a b
addPreds :: Int -> [b] -> GrContext a b -> GrContext a b
addPreds v :: Int
v ls :: [b]
ls c :: GrContext a b
c = GrContext a b
c { nodePreds :: IntMap [b]
nodePreds = Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v [b]
ls (IntMap [b] -> IntMap [b]) -> IntMap [b] -> IntMap [b]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c }

clearSucc :: Node -> [b] -> GrContext a b -> GrContext a b
clearSucc :: Int -> [b] -> GrContext a b -> GrContext a b
clearSucc v :: Int
v _ c :: GrContext a b
c = GrContext a b
c { nodeSuccs :: IntMap [b]
nodeSuccs = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v (IntMap [b] -> IntMap [b]) -> IntMap [b] -> IntMap [b]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c }

clearPred :: Node -> [b] -> GrContext a b -> GrContext a b
clearPred :: Int -> [b] -> GrContext a b -> GrContext a b
clearPred v :: Int
v _ c :: GrContext a b
c = GrContext a b
c { nodePreds :: IntMap [b]
nodePreds = Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v (IntMap [b] -> IntMap [b]) -> IntMap [b] -> IntMap [b]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c }

updAdj :: Map.IntMap (GrContext a b) -> Map.IntMap [b]
       -> ([b] -> GrContext a b -> GrContext a b)
       -> Map.IntMap (GrContext a b)
updAdj :: IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
updAdj g :: IntMap (GrContext a b)
g m :: IntMap [b]
m f :: [b] -> GrContext a b -> GrContext a b
f = (Int -> [b] -> IntMap (GrContext a b) -> IntMap (GrContext a b))
-> IntMap (GrContext a b) -> IntMap [b] -> IntMap (GrContext a b)
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
Map.foldrWithKey (\ v :: Int
v -> Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a b.
Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
updGrContext Int
v ((GrContext a b -> GrContext a b)
 -> IntMap (GrContext a b) -> IntMap (GrContext a b))
-> ([b] -> GrContext a b -> GrContext a b)
-> [b]
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> GrContext a b -> GrContext a b
f) IntMap (GrContext a b)
g IntMap [b]
m

updGrContext :: Node -> (GrContext a b -> GrContext a b)
             -> Map.IntMap (GrContext a b) -> Map.IntMap (GrContext a b)
updGrContext :: Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
updGrContext v :: Int
v f :: GrContext a b -> GrContext a b
f r :: IntMap (GrContext a b)
r = case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
r of
    Nothing -> String -> IntMap (GrContext a b)
forall a. HasCallStack => String -> a
error (String -> IntMap (GrContext a b))
-> String -> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.updGrContext no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v
    Just c :: GrContext a b
c -> Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v (GrContext a b -> GrContext a b
f GrContext a b
c) IntMap (GrContext a b)
r

composeGr :: Node -> GrContext a b -> Gr a b -> Gr a b
composeGr :: Int -> GrContext a b -> Gr a b -> Gr a b
composeGr v :: Int
v c :: GrContext a b
c (Gr g :: IntMap (GrContext a b)
g) = let
    g1 :: IntMap (GrContext a b)
g1 = IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b.
IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
updAdj IntMap (GrContext a b)
g (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c) (([b] -> GrContext a b -> GrContext a b) -> IntMap (GrContext a b))
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
addSuccs Int
v
    g2 :: IntMap (GrContext a b)
g2 = IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b.
IntMap (GrContext a b)
-> IntMap [b]
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
updAdj IntMap (GrContext a b)
g1 (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c) (([b] -> GrContext a b -> GrContext a b) -> IntMap (GrContext a b))
-> ([b] -> GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
addPreds Int
v
    g3 :: IntMap (GrContext a b)
g3 = Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v GrContext a b
c IntMap (GrContext a b)
g2
    in if Int -> IntMap (GrContext a b) -> Bool
forall a. Int -> IntMap a -> Bool
Map.member Int
v IntMap (GrContext a b)
g
       then String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.composeGr no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v
       else IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr IntMap (GrContext a b)
g3

-- | compute the possible cycle free paths from a start node
getPaths :: Node -> Gr a b -> [[LEdge b]]
getPaths :: Int -> Gr a b -> [[LEdge b]]
getPaths src :: Int
src gr :: Gr a b
gr = case Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
forall a b. Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr Int
src Gr a b
gr of
    Just (c :: GrContext a b
c, ng :: Gr a b
ng) ->
      (Int -> [b] -> [[LEdge b]] -> [[LEdge b]])
-> [[LEdge b]] -> IntMap [b] -> [[LEdge b]]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
Map.foldrWithKey (\ nxt :: Int
nxt lbls :: [b]
lbls l :: [[LEdge b]]
l ->
           [[LEdge b]]
l [[LEdge b]] -> [[LEdge b]] -> [[LEdge b]]
forall a. [a] -> [a] -> [a]
++ (b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: b
b -> [(Int
src, Int
nxt, b
b)]) [b]
lbls
             [[LEdge b]] -> [[LEdge b]] -> [[LEdge b]]
forall a. [a] -> [a] -> [a]
++ ([LEdge b] -> [[LEdge b]]) -> [[LEdge b]] -> [[LEdge b]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ p :: [LEdge b]
p -> (b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: b
b -> (Int
src, Int
nxt, b
b) LEdge b -> [LEdge b] -> [LEdge b]
forall a. a -> [a] -> [a]
: [LEdge b]
p) [b]
lbls)
                           (Int -> Gr a b -> [[LEdge b]]
forall a b. Int -> Gr a b -> [[LEdge b]]
getPaths Int
nxt Gr a b
ng)) [] (IntMap [b] -> [[LEdge b]]) -> IntMap [b] -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c
    Nothing -> String -> [[LEdge b]]
forall a. HasCallStack => String -> a
error (String -> [[LEdge b]]) -> String -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.getPaths no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
src

-- | compute the possible cycle free reversed paths from a start node
getAllPathsTo :: Node -> Gr a b -> [[LEdge b]]
getAllPathsTo :: Int -> Gr a b -> [[LEdge b]]
getAllPathsTo tgt :: Int
tgt gr :: Gr a b
gr = case Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
forall a b. Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr Int
tgt Gr a b
gr of
    Just (c :: GrContext a b
c, ng :: Gr a b
ng) ->
      (Int -> [b] -> [[LEdge b]] -> [[LEdge b]])
-> [[LEdge b]] -> IntMap [b] -> [[LEdge b]]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
Map.foldrWithKey (\ nxt :: Int
nxt lbls :: [b]
lbls l :: [[LEdge b]]
l ->
           [[LEdge b]]
l [[LEdge b]] -> [[LEdge b]] -> [[LEdge b]]
forall a. [a] -> [a] -> [a]
++ (b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: b
b -> [(Int
nxt, Int
tgt, b
b)]) [b]
lbls
             [[LEdge b]] -> [[LEdge b]] -> [[LEdge b]]
forall a. [a] -> [a] -> [a]
++ ([LEdge b] -> [[LEdge b]]) -> [[LEdge b]] -> [[LEdge b]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ p :: [LEdge b]
p -> (b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: b
b -> (Int
nxt, Int
tgt, b
b) LEdge b -> [LEdge b] -> [LEdge b]
forall a. a -> [a] -> [a]
: [LEdge b]
p) [b]
lbls)
                           (Int -> Gr a b -> [[LEdge b]]
forall a b. Int -> Gr a b -> [[LEdge b]]
getAllPathsTo Int
nxt Gr a b
ng)) [] (IntMap [b] -> [[LEdge b]]) -> IntMap [b] -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c
    Nothing -> String -> [[LEdge b]]
forall a. HasCallStack => String -> a
error (String -> [[LEdge b]]) -> String -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.getAllPathsTo no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tgt

-- | compute the possible cycle free paths from a start node to a target node.
getPathsTo :: Node -> Node -> Gr a b -> [[LEdge b]]
getPathsTo :: Int -> Int -> Gr a b -> [[LEdge b]]
getPathsTo src :: Int
src tgt :: Int
tgt gr :: Gr a b
gr = case Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
forall a b. Int -> Gr a b -> Maybe (GrContext a b, Gr a b)
decomposeGr Int
src Gr a b
gr of
    Just (c :: GrContext a b
c, ng :: Gr a b
ng) -> let
      s :: IntMap [b]
s = GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c
      in (Int -> [b] -> [[LEdge b]] -> [[LEdge b]])
-> [[LEdge b]] -> IntMap [b] -> [[LEdge b]]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
Map.foldrWithKey (\ nxt :: Int
nxt lbls :: [b]
lbls ->
            ([[LEdge b]] -> [[LEdge b]] -> [[LEdge b]]
forall a. [a] -> [a] -> [a]
++ ([LEdge b] -> [[LEdge b]]) -> [[LEdge b]] -> [[LEdge b]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ p :: [LEdge b]
p -> (b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ b :: b
b -> (Int
src, Int
nxt, b
b) LEdge b -> [LEdge b] -> [LEdge b]
forall a. a -> [a] -> [a]
: [LEdge b]
p) [b]
lbls)
                (Int -> Int -> Gr a b -> [[LEdge b]]
forall a b. Int -> Int -> Gr a b -> [[LEdge b]]
getPathsTo Int
nxt Int
tgt Gr a b
ng)))
          ((b -> [LEdge b]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> [a] -> [b]
map (\ lbl :: b
lbl -> [(Int
src, Int
tgt, b
lbl)]) ([b] -> [[LEdge b]]) -> [b] -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault [] Int
tgt IntMap [b]
s)
              (Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
tgt IntMap [b]
s)
    Nothing -> String -> [[LEdge b]]
forall a. HasCallStack => String -> a
error (String -> [[LEdge b]]) -> String -> [[LEdge b]]
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.getPathsTo no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
src

-- | get all the edge labels between two nodes
getLEdges :: Node -> Node -> Gr a b -> [b]
getLEdges :: Int -> Int -> Gr a b -> [b]
getLEdges v :: Int
v w :: Int
w (Gr m :: IntMap (GrContext a b)
m) = let err :: String
err = "Common.Lib.Graph.getLEdges: no node " in
  case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
m of
    Just c :: GrContext a b
c -> if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w then GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c else
      [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault
        (if Int -> IntMap (GrContext a b) -> Bool
forall a. Int -> IntMap a -> Bool
Map.member Int
w IntMap (GrContext a b)
m then [] else String -> [b]
forall a. HasCallStack => String -> a
error (String -> [b]) -> String -> [b]
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w)
        Int
w (IntMap [b] -> [b]) -> IntMap [b] -> [b]
forall a b. (a -> b) -> a -> b
$ GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c
    Nothing -> String -> [b]
forall a. HasCallStack => String -> a
error (String -> [b]) -> String -> [b]
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v

showEdge :: Node -> Node -> String
showEdge :: Int -> Int -> String
showEdge v :: Int
v w :: Int
w = Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ " -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w

-- | delete a labeled edge from a graph
delLEdge :: (b -> b -> Ordering) -> LEdge b -> Gr a b -> Gr a b
delLEdge :: (b -> b -> Ordering) -> LEdge b -> Gr a b -> Gr a b
delLEdge cmp :: b -> b -> Ordering
cmp (v :: Int
v, w :: Int
w, l :: b
l) (Gr m :: IntMap (GrContext a b)
m) =
  let e :: String
e = Int -> Int -> String
showEdge Int
v Int
w
      err :: String
err = "Common.Lib.Graph.delLEdge "
  in case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
m of
    Just c :: GrContext a b
c -> let
      sm :: IntMap [b]
sm = GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c
      b :: Bool
b = Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w
      ls :: [b]
ls = if Bool
b then GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c else [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault [] Int
w IntMap [b]
sm
      in case (b -> Bool) -> [b] -> ([b], [b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\ k :: b
k -> b -> b -> Ordering
cmp b
k b
l Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) [b]
ls of
           ([], _) -> String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "no edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
           ([_], rs :: [b]
rs) -> IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr (IntMap (GrContext a b) -> Gr a b)
-> IntMap (GrContext a b) -> Gr a b
forall a b. (a -> b) -> a -> b
$ if Bool
b then Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v GrContext a b
c { loops :: [b]
loops = [b]
rs } IntMap (GrContext a b)
m else
             Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a b.
Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
updGrContext Int
w
              ((if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
rs then Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
clearPred else Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
addPreds) Int
v [b]
rs)
              (IntMap (GrContext a b) -> IntMap (GrContext a b))
-> IntMap (GrContext a b) -> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v GrContext a b
c
                { nodeSuccs :: IntMap [b]
nodeSuccs = if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
rs then Int -> IntMap [b] -> IntMap [b]
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
w IntMap [b]
sm else
                    Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
w [b]
rs IntMap [b]
sm } IntMap (GrContext a b)
m
           _ -> String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "multiple edges: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
    Nothing -> String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ " for edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

-- | insert a labeled edge into a graph, returns False if edge exists
insLEdge :: Bool -> (b -> b -> Ordering) -> LEdge b -> Gr a b
         -> (Gr a b, Bool)
insLEdge :: Bool -> (b -> b -> Ordering) -> LEdge b -> Gr a b -> (Gr a b, Bool)
insLEdge failIfExist :: Bool
failIfExist cmp :: b -> b -> Ordering
cmp (v :: Int
v, w :: Int
w, l :: b
l) gr :: Gr a b
gr@(Gr m :: IntMap (GrContext a b)
m) =
  let e :: String
e = Int -> Int -> String
showEdge Int
v Int
w
      err :: String
err = "Common.Lib.Graph.insLEdge "
  in case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
m of
    Just c :: GrContext a b
c -> let
      sm :: IntMap [b]
sm = GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c
      b :: Bool
b = Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w
      ls :: [b]
ls = if Bool
b then GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c else [b] -> Int -> IntMap [b] -> [b]
forall a. a -> Int -> IntMap a -> a
Map.findWithDefault [] Int
w IntMap [b]
sm
      ns :: [b]
ns = (b -> b -> Ordering) -> b -> [b] -> [b]
forall a. (a -> a -> Ordering) -> a -> [a] -> [a]
insertBy b -> b -> Ordering
cmp b
l [b]
ls
      in if (b -> Bool) -> [b] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ k :: b
k -> b -> b -> Ordering
cmp b
k b
l Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) [b]
ls then
           if Bool
failIfExist then String -> (Gr a b, Bool)
forall a. HasCallStack => String -> a
error (String -> (Gr a b, Bool)) -> String -> (Gr a b, Bool)
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "multiple edges: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
           else (Gr a b
gr, Bool
False)
         else (IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr (IntMap (GrContext a b) -> Gr a b)
-> IntMap (GrContext a b) -> Gr a b
forall a b. (a -> b) -> a -> b
$ if Bool
b then Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v GrContext a b
c { loops :: [b]
loops = [b]
ns } IntMap (GrContext a b)
m else
                  Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a b.
Int
-> (GrContext a b -> GrContext a b)
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
updGrContext Int
w (Int -> [b] -> GrContext a b -> GrContext a b
forall b a. Int -> [b] -> GrContext a b -> GrContext a b
addPreds Int
v [b]
ns)
                  (IntMap (GrContext a b) -> IntMap (GrContext a b))
-> IntMap (GrContext a b) -> IntMap (GrContext a b)
forall a b. (a -> b) -> a -> b
$ Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v GrContext a b
c { nodeSuccs :: IntMap [b]
nodeSuccs = Int -> [b] -> IntMap [b] -> IntMap [b]
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
w [b]
ns IntMap [b]
sm } IntMap (GrContext a b)
m, Bool
True)
    Nothing -> String -> (Gr a b, Bool)
forall a. HasCallStack => String -> a
error (String -> (Gr a b, Bool)) -> String -> (Gr a b, Bool)
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ "no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ " for edge: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

isIsolated :: GrContext a b -> Bool
isIsolated :: GrContext a b -> Bool
isIsolated c :: GrContext a b
c = IntMap [b] -> Bool
forall a. IntMap a -> Bool
Map.null (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodeSuccs GrContext a b
c) Bool -> Bool -> Bool
&& IntMap [b] -> Bool
forall a. IntMap a -> Bool
Map.null (GrContext a b -> IntMap [b]
forall a b. GrContext a b -> IntMap [b]
nodePreds GrContext a b
c)

-- | delete a labeled node
delLNode :: (a -> a -> Bool) -> LNode a -> Gr a b -> Gr a b
delLNode :: (a -> a -> Bool) -> LNode a -> Gr a b -> Gr a b
delLNode eq :: a -> a -> Bool
eq (v :: Int
v, l :: a
l) (Gr m :: IntMap (GrContext a b)
m) =
  let err :: String
err = "Common.Lib.Graph.delLNode: node " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v in
  case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
m of
    Just c :: GrContext a b
c -> if GrContext a b -> Bool
forall a b. GrContext a b -> Bool
isIsolated GrContext a b
c Bool -> Bool -> Bool
&& [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GrContext a b -> [b]
forall a b. GrContext a b -> [b]
loops GrContext a b
c) then
                  if a -> a -> Bool
eq a
l (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ GrContext a b -> a
forall a b. GrContext a b -> a
nodeLabel GrContext a b
c then IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr (Int -> IntMap (GrContext a b) -> IntMap (GrContext a b)
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
v IntMap (GrContext a b)
m)
                     else String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ " has a different label"
              else String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ " has remaining edges"
    Nothing -> String -> Gr a b
forall a. HasCallStack => String -> a
error (String -> Gr a b) -> String -> Gr a b
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is missing"

-- | sets the node with new label and returns the new graph and the old label
labelNode :: LNode a -> Gr a b -> (Gr a b, a)
labelNode :: LNode a -> Gr a b -> (Gr a b, a)
labelNode (v :: Int
v, l :: a
l) (Gr m :: IntMap (GrContext a b)
m) = case Int -> IntMap (GrContext a b) -> Maybe (GrContext a b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
v IntMap (GrContext a b)
m of
    Just c :: GrContext a b
c -> (IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr (IntMap (GrContext a b) -> Gr a b)
-> IntMap (GrContext a b) -> Gr a b
forall a b. (a -> b) -> a -> b
$ Int
-> GrContext a b
-> IntMap (GrContext a b)
-> IntMap (GrContext a b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
v (GrContext a b
c { nodeLabel :: a
nodeLabel = a
l }) IntMap (GrContext a b)
m, GrContext a b -> a
forall a b. GrContext a b -> a
nodeLabel GrContext a b
c)
    Nothing -> String -> (Gr a b, a)
forall a. HasCallStack => String -> a
error (String -> (Gr a b, a)) -> String -> (Gr a b, a)
forall a b. (a -> b) -> a -> b
$ "Common.Lib.Graph.labelNode no node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v

-- | returns one new node id for the given graph
getNewNode :: Gr a b -> Node
getNewNode :: Gr a b -> Int
getNewNode g :: Gr a b
g = case Int -> Gr a b -> [Int]
forall (gr :: * -> * -> *) a b. Graph gr => Int -> gr a b -> [Int]
newNodes 1 Gr a b
g of
    [n :: Int
n] -> Int
n
    _ -> String -> Int
forall a. HasCallStack => String -> a
error "Common.Lib.Graph.getNewNode"

-- | remove isolated nodes without edges
rmIsolated :: Gr a b -> Gr a b
rmIsolated :: Gr a b -> Gr a b
rmIsolated (Gr m :: IntMap (GrContext a b)
m) = IntMap (GrContext a b) -> Gr a b
forall a b. IntMap (GrContext a b) -> Gr a b
Gr (IntMap (GrContext a b) -> Gr a b)
-> IntMap (GrContext a b) -> Gr a b
forall a b. (a -> b) -> a -> b
$ (GrContext a b -> Bool)
-> IntMap (GrContext a b) -> IntMap (GrContext a b)
forall a. (a -> Bool) -> IntMap a -> IntMap a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (GrContext a b -> Bool) -> GrContext a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GrContext a b -> Bool
forall a b. GrContext a b -> Bool
isIsolated) IntMap (GrContext a b)
m