0N/A{- |

0N/AModule : $Header$

0N/ACopyright : (c) Martin Erwig, Christian Maeder and Uni Bremen 1999-2006

0N/ALicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

0N/A

0N/AMaintainer : maeder@tzi.de

0N/AStability : provisional

0N/APortability : portable

0N/A

0N/ATree-based implementation of 'Graph' and 'DynGraph' using Common.Lib.Map

0N/Ainstead of Data.Graph.Inductive.Internal.FiniteMap

0N/A-}

0N/A

0N/Amodule Common.Lib.Graph (Gr(..)) where

0N/A

0N/Aimport Data.Graph.Inductive.Graph

0N/Aimport qualified Common.Lib.Map as Map

0N/A

0N/A-- | the graph type constructor

0N/Anewtype Gr a b = Gr { toMap :: Map.Map Node (Adj b, a, Adj b) }

0N/A

0N/Atype GraphRep a b = Map.Map Node (Context' a b)

0N/Atype Context' a b = (Adj b, a, Adj b)

0N/A

0N/Ainstance (Show a,Show b) => Show (Gr a b) where

0N/A show (Gr g) = showGraph g

0N/A

0N/Ainstance Graph Gr where

0N/A empty = Gr Map.empty

0N/A isEmpty (Gr g) = Map.null g

0N/A match = matchGr

0N/A mkGraph vs es = (insEdges es . insNodes vs) empty

0N/A labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (Map.toList g)

334N/A -- more efficient versions of derived class members

334N/A --

334N/A matchAny (Gr g) = if Map.null g then error "Match Exception, Empty Graph"

0N/A else (c,g') where (Just c,g') = matchGr (fst $ Map.findMin g) (Gr g)

0N/A noNodes (Gr g) = Map.size g

0N/A nodeRange (Gr g) = if Map.null g then (0, -1)

0N/A else (fst $ Map.findMin g, fst $ Map.findMax g)

0N/A labEdges (Gr g) =

0N/A concatMap (\(v,(_,_,s))->map (\(l,w)->(v,w,l)) s) (Map.toList g)

0N/A

0N/A{- self edges are only stored as successors and thus are not

0N/Aconsidered as ingoing edges! -}

0N/A

0N/Ainstance DynGraph Gr where

0N/A (p,v,l,s) & (Gr g) | Map.member v g =

0N/A error ("Node Exception, Node: "++show v)

0N/A | otherwise = Gr g3

0N/A where s' = filter ((/=v).snd) s

0N/A p' = filter ((/=v).snd) p

0N/A g1 = Map.insert v (p', l, s) g

0N/A g2 = updAdj g1 p' (addSucc v)

0N/A g3 = updAdj g2 s' (addPred v)

0N/A

334N/A----------------------------------------------------------------------

334N/A-- UTILITIES

0N/A----------------------------------------------------------------------

0N/A

0N/AshowGraph :: (Show a, Show b) => GraphRep a b -> String

0N/AshowGraph gr = unlines $ map (\ (v,(_,l',s)) ->

0N/A show v ++ ":" ++ show l' ++ " ->" ++ show s)

0N/A $ Map.toList gr

0N/A

0N/AmatchGr :: Node -> Gr a b -> Decomp Gr a b

0N/AmatchGr v (Gr g) =

0N/A case Map.lookup v g of

0N/A Nothing -> (Nothing, Gr g)

0N/A Just (p,l,s) -> (Just (p',v,l,s), Gr g2)

0N/A where s' = filter ((/=v).snd) s

0N/A p' = filter ((/=v).snd) p

0N/A g' = Map.delete v g

0N/A g1 = updAdj g' s' (clearPred v)

0N/A g2 = updAdj g1 p' (clearSucc v)

0N/A

0N/AaddSucc :: Node -> b -> Context' a b -> Context' a b

0N/AaddSucc v l (p,l',s) = (p,l',(l,v):s)

0N/A

334N/AaddPred :: Node -> b -> Context' a b -> Context' a b

334N/AaddPred v l (p,l',s) = ((l,v):p,l',s)

334N/A

334N/AclearSucc :: Node -> b -> Context' a b -> Context' a b

334N/AclearSucc v _ (p,l,s) = (p,l,filter ((/=v).snd) s)

334N/A

334N/AclearPred :: Node -> b -> Context' a b -> Context' a b

334N/AclearPred v _ (p,l,s) = (filter ((/=v).snd) p,l,s)

334N/A

334N/AupdAdj :: GraphRep a b -> Adj b -> (b -> Context' a b -> Context' a b)

334N/A -> GraphRep a b

334N/AupdAdj g [] _ = g

334N/AupdAdj g ((l,v):vs) f | Map.member v g = updAdj (Map.adjust (f l) v g) vs f

334N/A | otherwise = error ("Edge Exception, Node: "++show v)

334N/A