1 ;;; directed graph package.
4 ;; A directed graph is represented as vector of lists of integers.
5 ;; The number of nodes in the graph is length of the vector.
7 ;; i'th list of the vector contains j <=> there is the edge from i to j.
9 (defalias 'digraph-descents 'aref)
11 (defun digraph-split-as-dag (g)
12 "Returns 3 element vector of follows.
14 0. Directed acyclic graph generated by mergeing each strongly connected
15 components in G as new nodes.
17 1. Map from a node in g to a node in result.
19 2. Map from a node in result to nodes in g."
20 (let* ((old-len (length g))
21 (new-to-olds (vconcat (digraph-tsort g)))
22 (new-len (length new-to-olds))
23 (old-to-new (make-vector old-len ()))
27 (setq js (aref new-to-olds i))
29 (aset old-to-new (car js) i)
44 (if (= i (aref old-to-new old))
46 (list (aref old-to-new old))))
48 (aref new-to-olds i))))
56 (defun digraph-split-as-forest (g)
57 "Returns 3 element vector of follows.
59 0. Tree generated by merging nodes which have common descent node.
61 1. Map from a node in g to a node in result.
63 2. Map from a node in result to nodes in g."
64 (let* ((tmp (digraph-split-as-dag g))
68 ;;(_ (error "%s" tmp))
69 (tmp (digraph-dag-to-forest d))
76 (setq i (1- (length g)))
78 (setq old-indices (cons i old-indices)
80 (setq i (1- (length f)))
82 (setq new-indices (cons i new-indices)
88 (lambda (gi) (aref d-to-f (aref g-to-d gi)))
96 (lambda (di) (aref d-to-g di))
100 (defun digraph-tsort (dep)
101 "Sort nodes in a graph toporogicaly.
103 DEP is a vector of lists of integers and
104 digraph-tsort returns list of lists of integers.
106 The graph has (length DEP) nodes.
108 Dependency for i'th node is represented by i'th element of DEP.
109 If (aref DEP i) is a list (j1 j2 ... jn), it represents that i'th node
110 depends to j1, j2, ... and jn'th nodes of the graph.
112 A result of digraph-tsort is a sequence of sets of indexes for each
113 strongly connected nodes ordered by indepenedent to dependent as list
114 of lists of integers.
116 If (nth n result) contains an integer i, it represents the fact as
119 1. For all j in (nth n result) and j != i, i'th node depends to j'th
122 2. For all m < n and j in (nth m result), i'th nodes does not depend
124 (let* ((len (length dep))
125 (ord (make-vector len nil))
129 (if (not (aref ord i))
130 (setq res (nth 3 (digraph-tsort-visit dep len ord i 0 () res))))
134 (defun digraph-tsort-visit (dep len ord i id stk res)
136 (let ((js (aref dep i))
142 (let* ((j (car js)) (jo (aref ord j)))
144 (setq m (if (< m jo) m jo))
145 (let* ((tmp (digraph-tsort-visit dep len ord j nid stk res))
147 (setq m (if (< m m0) m m0)
153 (let* ((p (member i stk))
158 (aset ord (car tmp) len)
159 (setq tmp (cdr tmp)))
160 (list m nid nstk (cons stk res)))
161 (list m nid stk res))))
163 (defun digraph-reverse (g)
164 "Return graph with reversed edge."
165 (let* ((len (length g))
166 (rev (make-vector len nil))
169 (let ((links (aref g i)))
171 (if (not (member i (aref rev (car links))))
172 (aset rev (car links) (cons i (aref rev (car links)))))
173 (setq links (cdr links))))
177 (defun digraph-leaves (g)
178 "Return list of leaves of G."
179 (let* ((i (length g))
183 (if (null (aref g i))
184 (setq res (cons i res))))
187 (defun digraph-roots (g)
188 "Return list of roots of G."
189 (digraph-leaves (digraph-reverse g)))
193 (defun digraph-dag-to-forest (dag)
194 "Convert a DAG(directed acyclic graph) to forest(set of trees)."
195 (let* ((len (length dag))
196 (rev (digraph-reverse dag))
197 (forest (digraph-forest-make len))
200 (digraph-dag-forest-add-node forest i (aref rev i))
202 ;;(error "%s" forest)
203 (digraph-forest-to-graph forest)))
205 (defun digraph-dag-forest-add-node (forest node links)
207 (digraph-forest-add-tree forest node)
208 (let ((parent (car links)))
209 (setq links (cdr links))
210 (digraph-forest-add-node forest parent node)
212 (digraph-forest-merge-node forest parent (car links))
213 (setq links (cdr links)))))
216 ;; forest = [last-tree-id node-merge-map node-parent-map]
217 (defun digraph-forest-make (num)
218 (vector 0 (make-vector num nil) (make-vector num nil)))
219 (defsubst digraph-forest-merge-map (forest) (aref forest 1))
220 (defsubst digraph-forest-parent-map (forest) (aref forest 2))
222 (defun digraph-forest-add-tree (forest node)
223 (aset (digraph-forest-parent-map forest)
225 (aset forest 0 (1- (aref forest 0)))))
227 (defun digraph-forest-add-node (forest parent node)
228 (aset (digraph-forest-parent-map forest) node parent))
230 (defun digraph-forest-node-id (forest node)
231 (let ((merge-map (digraph-forest-merge-map forest)) tmp)
232 (while (setq tmp (aref merge-map node))
236 (defun digraph-forest-tree-id (forest node)
237 (setq node (digraph-forest-node-id forest node))
238 (let ((parent-map (digraph-forest-parent-map forest))
240 (while (<= 0 (setq tmp (aref parent-map node)))
241 (setq node (digraph-forest-node-id forest tmp)))
244 (defun digraph-forest-root-p (forest node)
245 (setq node (digraph-forest-node-id forest node))
246 (< (aref (digraph-forest-parent-map forest) node) 0))
248 (defun digraph-forest-path-to-root (forest node)
249 (setq node (digraph-forest-node-id forest node))
250 (let ((parent-map (digraph-forest-parent-map forest))
252 (while (not (digraph-forest-root-p forest node))
253 (setq node (digraph-forest-node-id forest (aref parent-map node))
254 path (cons node path)))
257 (defun digraph-forest-merge-node (forest n1 n2)
258 (setq n1 (digraph-forest-node-id forest n1)
259 n2 (digraph-forest-node-id forest n2))
260 (let ((t1 (digraph-forest-tree-id forest n1))
261 (t2 (digraph-forest-tree-id forest n2)))
263 (let ((merge-map (digraph-forest-merge-map forest))
264 (p1 (digraph-forest-path-to-root forest n1))
265 (p2 (digraph-forest-path-to-root forest n2))
268 (= (car p1) (car p2)))
272 (setq p1 (nreverse p1))
273 (setq p2 (nreverse p2))
275 (aset merge-map (car p2) (car p1))
279 (let ((ns (nconc p1 p2)) n)
281 (aset merge-map (car ns) top)
282 (setq ns (cdr ns))))))
283 (let ((merge-map (digraph-forest-merge-map forest))
284 (parent-map (digraph-forest-parent-map forest)))
285 (while (and (not (digraph-forest-root-p forest n1))
286 (not (digraph-forest-root-p forest n2)))
287 (aset merge-map n2 n1)
288 (setq n1 (digraph-forest-node-id forest (aref parent-map n1))
289 n2 (digraph-forest-node-id forest (aref parent-map n2))))
290 (if (digraph-forest-root-p forest n2)
291 (aset merge-map n2 n1)
292 (aset merge-map n1 n2)))))
295 (defun digraph-forest-to-graph (forest)
296 (let* ((merge-map (digraph-forest-merge-map forest))
297 (parent-map (digraph-forest-parent-map forest))
298 (old-len (length merge-map))
299 (old-to-new (make-vector old-len nil))
307 (setq j (digraph-forest-node-id forest i))
308 (if (aref old-to-new j)
309 (aset old-to-new i (aref old-to-new j))
311 (aset old-to-new j new-len)
312 (aset old-to-new i new-len)
313 (setq new-len (1+ new-len))))
315 (setq new-to-olds (make-vector new-len nil)
316 graph (make-vector new-len nil))
317 (setq i (1- old-len))
319 (setq j (aref old-to-new i))
321 (cons i (aref new-to-olds j)))
325 (setq j (aref parent-map (digraph-forest-node-id forest (car (aref new-to-olds i)))))
326 (if (<= 0 j) (aset graph (aref old-to-new j)
327 (cons i (aref graph (aref old-to-new j)))))
329 (vector graph old-to-new new-to-olds)))
333 (defun digraph-list-uniq (il)
336 (if (member (car il) (cdr il))
337 (digraph-list-uniq (cdr il))
338 (cons (car il) (digraph-list-uniq (cdr il))))))
341 (digraph-split-as-forest [nil nil nil nil nil nil nil nil nil nil (10) nil nil (12) (13) (0 1 2 3 4 5 6 7 8 9 10 11 13 14)])
343 [(14 13 12 11 10 9 8 7 6 5 4 3 1) (2) nil nil nil nil nil nil nil nil nil nil nil nil nil]
344 [14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 0]
345 [(15) (14) (13) (12) (11) (10) (9) (8) (7) (6) (5) (4) (3) (2) (1) (0)]]