-- (c) 1999 - 2002 by Martin Erwig [see file COPYRIGHT] -- | Basic Graph Algorithms module Data.Graph.Inductive.Basic ( -- * Graph Operations grev, undir,unlab, gsel, gfold, -- * Filter Operations efilter,elfilter, -- * Predicates and Classifications hasLoop,isSimple, -- * Tree Operations postorder, postorderF, preorder, preorderF ) where import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.Thread (threadMaybe,threadList) import Data.List (nub) import Data.Tree -- | Reverse the direction of all edges. grev :: DynGraph gr => gr a b -> gr a b grev = gmap (\(p,v,l,s)->(s,v,l,p)) -- | Make the graph undirected, i.e. for every edge from A to B, there -- exists an edge from B to A. undir :: (Eq b,DynGraph gr) => gr a b -> gr a b undir = gmap (\(p,v,l,s)->let ps = nub (p++s) in (ps,v,l,ps)) -- this version of undir considers edge lables and keeps edges with -- different labels, an alternative is the definition below: -- undir = gmap (\(p,v,l,s)-> -- let ps = nubBy (\x y->snd x==snd y) (p++s) in (ps,v,l,ps)) -- | Remove all labels. unlab :: DynGraph gr => gr a b -> gr () () unlab = gmap (\(p,v,_,s)->(unlabAdj p,v,(),unlabAdj s)) where unlabAdj = map (\(_,v)->((),v)) -- alternative: -- unlab = nmap (\_->()) . emap (\_->()) -- | Return all 'Context's for which the given function returns 'True'. gsel :: Graph gr => (Context a b -> Bool) -> gr a b -> [Context a b] gsel p = ufold (\c cs->if p c then c:cs else cs) [] -- filter operations -- -- efilter : filter based on edge property -- elfilter : filter based on edge label property -- -- | Filter based on edge property. efilter :: DynGraph gr => (LEdge b -> Bool) -> gr a b -> gr a b efilter f = ufold cfilter empty where cfilter (p,v,l,s) g = (p',v,l,s') & g where p' = filter (\(b,u)->f (u,v,b)) p s' = filter (\(b,w)->f (v,w,b)) s -- | Filter based on edge label property. elfilter :: DynGraph gr => (b -> Bool) -> gr a b -> gr a b elfilter f = efilter (\(_,_,b)->f b) -- some predicates and classifications -- -- | 'True' if the graph has any edges of the form (A, A). hasLoop :: Graph gr => gr a b -> Bool hasLoop = not . null . (gsel (\c->(node' c `elem` suc' c))) -- | The inverse of 'hasLoop'. isSimple :: Graph gr => gr a b -> Bool isSimple = not . hasLoop threadGraph f c = threadMaybe f c match -- gfold1 f d b u = threadGraph (\c->d (labNode' c)) (\c->gfoldn f d b u (f c)) gfold1 f d b = threadGraph d (\c->gfoldn f d b (f c)) gfoldn f d b = threadList b (gfold1 f d b) -- gfold :: ((Context a b) -> [Node]) -> ((Node,a) -> c -> d) -> -- (Maybe d -> c -> c) -> c -> [Node] -> Graph a b -> c -- gfold f d b u l g = fst (gfoldn f d b u l g) -- type Dir a b = (Context a b) -> [Node] -- direction of fold -- type Dagg a b c = (Node,a) -> b -> c -- depth aggregation -- type Bagg a b = (Maybe a -> b -> b,b) -- breadth/level aggregation -- -- gfold :: (Dir a b) -> (Dagg a c d) -> (Bagg d c) -> [Node] -> Graph a b -> c -- gfold f d (b,u) l g = fst (gfoldn f d b u l g) -- | Directed graph fold. gfold :: Graph gr => ((Context a b) -> [Node]) -- ^ direction of fold -> ((Context a b) -> c -> d) -- ^ depth aggregation -> (Maybe d -> c -> c, c) -- ^ breadth\/level aggregation -> [Node] -> gr a b -> c gfold f d b l g = fst (gfoldn f d b l g) -- not finished yet ... -- -- undirBy :: (b -> b -> b) -> Graph a b -> Graph a b -- undirBy = gmap (\(p,v,l,s)->let ps = nub (p++s) in (ps,v,l,ps)) -- | Flatten a 'Tree', returning the elements in post-order. postorder :: Tree a -> [a] postorder (Node v ts) = postorderF ts ++ [v] -- | Flatten multiple 'Tree's in post-order. postorderF :: [Tree a] -> [a] postorderF = concatMap postorder -- | Flatten a 'Tree', returning the elements in pre-order. Equivalent to --'flatten' in 'Data.Tree'. preorder :: Tree a -> [a] preorder = flatten -- | Flatten multiple 'Tree's in pre-order. preorderF :: [Tree a] -> [a] preorderF = concatMap preorder