/usr/lib/hugs/packages/fgl/Data/Graph/Inductive/Basic.hs is in libhugs-fgl-bundled 98.200609.21-5.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | -- (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
|