/usr/lib/hugs/packages/fgl/Data/Graph/Inductive/Query/BFS.hs is in libhugs-fgl-bundled 98.200609.21-5.3ubuntu1.
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 127 128 129 130 | -- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]
-- | Breadth-First Search Algorithms
module Data.Graph.Inductive.Query.BFS(
-- * BFS Node List
bfs,bfsn,bfsWith,bfsnWith,
-- * Node List With Depth Info
level,leveln,
-- * BFS Edges
bfe,bfen,
-- * BFS Tree
bft,lbft,
-- * Shortest Path (Number of Edges)
esp,lesp
) where
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Internal.Queue
import Data.Graph.Inductive.Internal.RootPath
-- bfs (node list ordered by distance)
--
bfsnInternal :: Graph gr => (Context a b -> c) -> Queue Node -> gr a b -> [c]
bfsnInternal f q g | queueEmpty q || isEmpty g = []
| otherwise =
case match v g of
(Just c, g') -> f c:bfsnInternal f (queuePutList (suc' c) q') g'
(Nothing, g') -> bfsnInternal f q' g'
where (v,q') = queueGet q
bfsnWith :: Graph gr => (Context a b -> c) -> [Node] -> gr a b -> [c]
bfsnWith f vs = bfsnInternal f (queuePutList vs mkQueue)
bfsn :: Graph gr => [Node] -> gr a b -> [Node]
bfsn = bfsnWith node'
bfsWith :: Graph gr => (Context a b -> c) -> Node -> gr a b -> [c]
bfsWith f v = bfsnInternal f (queuePut v mkQueue)
bfs :: Graph gr => Node -> gr a b -> [Node]
bfs = bfsWith node'
-- level (extension of bfs giving the depth of each node)
--
level :: Graph gr => Node -> gr a b -> [(Node,Int)]
level v = leveln [(v,0)]
suci c i = zip (suc' c) (repeat i)
leveln :: Graph gr => [(Node,Int)] -> gr a b -> [(Node,Int)]
leveln [] _ = []
leveln _ g | isEmpty g = []
leveln ((v,j):vs) g = case match v g of
(Just c,g') -> (v,j):leveln (vs++suci c (j+1)) g'
(Nothing,g') -> leveln vs g'
-- bfe (breadth first edges)
-- remembers predecessor information
--
bfenInternal :: Graph gr => Queue Edge -> gr a b -> [Edge]
bfenInternal q g | queueEmpty q || isEmpty g = []
| otherwise =
case match v g of
(Just c, g') -> (u,v):bfenInternal (queuePutList (outU c) q') g'
(Nothing, g') -> bfenInternal q' g'
where ((u,v),q') = queueGet q
bfen :: Graph gr => [Edge] -> gr a b -> [Edge]
bfen vs g = bfenInternal (queuePutList vs mkQueue) g
bfe :: Graph gr => Node -> gr a b -> [Edge]
bfe v = bfen [(v,v)]
outU c = map (\(v,w,_)->(v,w)) (out' c)
-- bft (breadth first search tree)
-- here: with inward directed trees
--
-- bft :: Node -> gr a b -> IT.InTree Node
-- bft v g = IT.build $ map swap $ bfe v g
-- where swap (x,y) = (y,x)
--
-- sp (shortest path wrt to number of edges)
--
-- sp :: Node -> Node -> gr a b -> [Node]
-- sp s t g = reverse $ IT.rootPath (bft s g) t
-- faster shortest paths
-- here: with root path trees
--
bft :: Graph gr => Node -> gr a b -> RTree
bft v = bf (queuePut [v] mkQueue)
bf :: Graph gr => Queue Path -> gr a b -> RTree
bf q g | queueEmpty q || isEmpty g = []
| otherwise =
case match v g of
(Just c, g') -> p:bf (queuePutList (map (:p) (suc' c)) q') g'
(Nothing, g') -> bf q' g'
where (p@(v:_),q') = queueGet q
esp :: Graph gr => Node -> Node -> gr a b -> Path
esp s t = getPath t . bft s
-- lesp is a version of esp that returns labeled paths
-- Note that the label of the first node in a returned path is meaningless;
-- all other nodes are paired with the label of their incoming edge.
--
lbft :: Graph gr => Node -> gr a b -> LRTree b
lbft v g = case (out g v) of
[] -> [LP []]
(v',_,l):_ -> lbf (queuePut (LP [(v',l)]) mkQueue) g
lbf :: Graph gr => Queue (LPath b) -> gr a b -> LRTree b
lbf q g | queueEmpty q || isEmpty g = []
| otherwise =
case match v g of
(Just c, g') ->
LP p:lbf (queuePutList (map (\v' -> LP (v':p)) (lsuc' c)) q') g'
(Nothing, g') -> lbf q' g'
where ((LP (p@((v,_):_))),q') = queueGet q
lesp :: Graph gr => Node -> Node -> gr a b -> LPath b
lesp s t = getLPath t . lbft s
|