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
131
132
133
134
135
136
|
{------------------------------------------------------------------------------
DFS
This module is a portable version of the ghc-specific `DFS.g.hs', which is
itself a straightforward encoding of the Launchbury/King paper on linear graph
algorithms. This module uses balanced binary trees instead of mutable arrays
to implement the depth-first search so the complexity of the algorithms is
n.log(n) instead of linear.
The vertices of the graphs manipulated by these modules are labelled with the
integers from 0 to n-1 where n is the number of vertices in the graph.
The module's principle products are `mk_graph' for constructing a graph from an
edge list, `t_close' for taking the transitive closure of a graph and `scc'
for generating a list of strongly connected components; the components are
listed in dependency order and each component takes the form of a `dfs tree'
(see Launchberry and King). Thus if each edge (fid,fid') encodes the fact that
function `fid' references function `fid'' in a program then `scc' performs a
dependency analysis.
Chris Dornan, 23-Jun-94, 2-Jul-96, 29-Aug-96, 29-Sep-97
------------------------------------------------------------------------------}
module DFS where
import Set ( Set )
import qualified Set hiding ( Set )
import Data.Array ( (!), accumArray, listArray )
-- The result of a depth-first search of a graph is a list of trees,
-- `GForrest'. `post_order' provides a post-order traversal of a forrest.
type GForrest = [GTree]
data GTree = GNode Int GForrest
postorder:: GForrest -> [Int]
postorder ts = po ts []
where
po ts' l = foldr po_tree l ts'
po_tree (GNode a ts') l = po ts' (a:l)
list_tree:: GTree -> [Int]
list_tree t = l_t t []
where
l_t (GNode x ts) l = foldr l_t (x:l) ts
-- Graphs are represented by a pair of an integer, giving the number of nodes
-- in the graph, and function mapping each vertex (0..n-1, n=size of graph) to
-- its neighbouring nodes. `mk_graph' takes a size and an edge list and
-- constructs a graph.
type Graph = (Int,Int->[Int])
type Edge = (Int,Int)
mk_graph:: Int -> [Edge] -> Graph
mk_graph sz es = (sz,\v->ar!v)
where
ar = accumArray (flip (:)) [] (0,sz-1) [(v,v')| (v,v')<-es]
vertices:: Graph -> [Int]
vertices (sz,_) = [0..sz-1]
out:: Graph -> Int -> [Int]
out (_,f) = f
edges:: Graph -> [Edge]
edges g = [(v,v')| v<-vertices g, v'<-out g v]
rev_edges:: Graph -> [Edge]
rev_edges g = [(v',v)| v<-vertices g, v'<-out g v]
reverse_graph:: Graph -> Graph
reverse_graph g@(sz,_) = mk_graph sz (rev_edges g)
-- `t_close' takes the transitive closure of a graph; `scc' returns the stronly
-- connected components of the graph and `top_sort' topologically sorts the
-- graph. Note that the array is given one more element in order to avoid
-- problems with empty arrays.
t_close:: Graph -> Graph
t_close g@(sz,_) = (sz,\v->ar!v)
where
ar = listArray (0,sz) ([postorder(dff' [v] g)| v<-vertices g]++[und])
und = error "t_close"
scc:: Graph -> GForrest
scc g = dff' (reverse (top_sort (reverse_graph g))) g
top_sort:: Graph -> [Int]
top_sort = postorder . dff
-- `dff' computes the depth-first forrest. It works by unrolling the
-- potentially infinite tree from each of the vertices with `generate_g' and
-- then pruning out the duplicates.
dff:: Graph -> GForrest
dff g = dff' (vertices g) g
dff':: [Int] -> Graph -> GForrest
dff' vs (_bs, f) = prune (map (generate_g f) vs)
generate_g:: (Int->[Int]) -> Int -> GTree
generate_g f v = GNode v (map (generate_g f) (f v))
prune:: GForrest -> GForrest
prune ts = snd(chop(empty_int,ts))
where
empty_int:: Set Int
empty_int = Set.empty
chop:: (Set Int,GForrest) -> (Set Int,GForrest)
chop p@(_, []) = p
chop (vstd,GNode v ts:us) =
if v `Set.member` vstd
then chop (vstd,us)
else let vstd1 = Set.insert v vstd
(vstd2,ts') = chop (vstd1,ts)
(vstd3,us') = chop (vstd2,us)
in
(vstd3,GNode v ts' : us')
{-- Some simple test functions
test:: Graph Char
test = mk_graph (char_bds ('a','h')) (mk_pairs "eefggfgegdhfhged")
where
mk_pairs [] = []
mk_pairs (a:b:l) = (a,b):mk_pairs l
-}
|
