The unpac monorepo manager self-hosting as a monorepo using unpac
Eulerian paths/cycles for directed graphs
+91
-13
-1
CHANGES.md
-1
CHANGES.md
···
1
1
2
2
- [Classic]: new functions [cycle] and [grid]
3
3
- [Eulerian]: Eulerian paths (new module)
4
-
currently limited to undirected graphs
5
4
- [Components]: strong articulation points (see functors [Connectivity]
6
5
and [BiConnectivity]) (Timothy Bourke)
7
6
- [Dominator]: non-trivial dominators (Timothy Bourke)
+50
-10
src/eulerian.ml
+50
-10
src/eulerian.ml
···
56
56
57
57
type out = E.t H.t H.t
58
58
59
+
let add_out_edge out x y e =
60
+
let s = try H.find out x
61
+
with Not_found -> let s = H.create 4 in H.add out x s; s in
62
+
H.add s y e
63
+
59
64
(** compute the table of outgoing edges *)
60
65
let setup g : int * out =
61
66
let nbe = ref 0 in
62
67
let out = H.create 16 in
63
-
let add h x y e =
64
-
let s = try H.find h x
65
-
with Not_found -> let s = H.create 4 in H.add h x s; s in
66
-
if H.mem s y then invalid_arg "Eulerian.path (multigraphs not allowed)";
67
-
H.add s y e in
68
68
let add e =
69
69
incr nbe;
70
70
let x = E.src e and y = E.dst e in
71
-
add out x y e;
72
-
if not is_directed && not (V.equal x y) then add out y x (rev e) in
71
+
add_out_edge out x y e;
72
+
if not is_directed && not (V.equal x y) then
73
+
add_out_edge out y x (rev e) in
73
74
iter_edges_e add g;
74
75
!nbe, out
75
76
···
180
181
let x, _ = any odds in
181
182
H.remove odds x;
182
183
let y, _ = any odds in
184
+
183
185
if mem_edge out x y then (
184
-
(* there is an edge x--y => it connects two Eulerian cycles *)
186
+
(* there is an edge x--y => it connects 1 or 2 Eulerian cycles *)
185
187
let xy = H.find (H.find out x) y in
186
188
remove_edge out xy;
187
189
match out_degree out x, out_degree out y with
···
215
217
if H.length out > 0 then invalid_arg "Eulerian.path (not connected)";
216
218
path, cycle
217
219
218
-
let directed _g =
219
-
invalid_arg "Eulerian.path (directed graphs not yet supported)"
220
+
let directed g =
221
+
let delta = H.create 16 in (* out - in *)
222
+
let add v d =
223
+
H.replace delta v (d + try H.find delta v with Not_found -> 0) in
224
+
let add e =
225
+
add (E.src e) 1; add (E.dst e) (-1) in
226
+
iter_edges_e add g;
227
+
let start = ref None and finish = ref None in
228
+
let check v = function
229
+
| 1 when !start = None -> start := Some v
230
+
| -1 when !finish = None -> finish := Some v
231
+
| 0 -> ()
232
+
| _ -> invalid_arg "Eulerian.path (bad degrees)" in
233
+
H.iter check delta;
234
+
let nbe, out = setup g in
235
+
let path, cycle = match !start, !finish with
236
+
| None, None when nbe = 0 ->
237
+
[], true
238
+
| None, None ->
239
+
let v, _ = any out in list_of (eulerian_cycle out v), true
240
+
| Some s, Some f ->
241
+
(* add one edge f->s, build a cycle, then remove it
242
+
note: there may be already an edge f->s
243
+
if so, we are adding *a second one* and we are careful
244
+
about removing this one, not the other *)
245
+
let dummy = E.label (snd (any (H.find out s))) in
246
+
let fs = E.create f dummy s in
247
+
add_out_edge out f s fs;
248
+
let p = eulerian_cycle out s in
249
+
let rec find e = (* lookup for f->s, to break the cycle there *)
250
+
if e.edge == fs then e else find e.next in
251
+
let start = find p in
252
+
List.tl (list_of start), false
253
+
| Some _, None
254
+
| None, Some _ ->
255
+
assert false (* since the sum of all deltas is zero *)
256
+
in
257
+
(* check that all edges have been consumed *)
258
+
if H.length out > 0 then invalid_arg "Eulerian.path (not connected)";
259
+
path, cycle
220
260
221
261
let path =
222
262
if is_directed then directed else undirected
-1
src/eulerian.mli
-1
src/eulerian.mli
+41
-1
tests/test_eulerian.ml
+41
-1
tests/test_eulerian.ml
···
42
42
let () = assert (path_length g = 2)
43
43
44
44
let () = add_edge g v2 v0
45
-
let p, c = Eulerian.path g
46
45
let () = assert (exists_path g)
47
46
let () = assert (exists_cycle g)
48
47
let () = assert (path_length g = 3)
···
98
97
assert (not c);
99
98
assert (List.length p = 7)
100
99
100
+
open Pack.Digraph
101
+
102
+
let exists_path g =
103
+
try ignore (Eulerian.path g); true with Invalid_argument _ -> false
104
+
let exists_cycle g =
105
+
try ignore (Eulerian.cycle g); true with Invalid_argument _ -> false
106
+
107
+
let () =
108
+
for n = 0 to 4 do
109
+
let g, v = Classic.cycle n in
110
+
let p, c = Eulerian.path g in
111
+
assert c;
112
+
assert (List.length p = n);
113
+
if n > 1 then (
114
+
remove_edge g v.(0) v.(1);
115
+
let p, c = Eulerian.path g in
116
+
assert (not c);
117
+
assert (List.length p = n - 1);
118
+
)
119
+
done
120
+
121
+
let g, v = Classic.cycle 5
122
+
let () = add_edge g v.(1) v.(4)
123
+
let () = assert (not (exists_cycle g))
124
+
let () = assert (exists_path g)
125
+
let () = add_edge g v.(4) v.(1)
126
+
let () = assert (exists_cycle g)
127
+
128
+
(* +------- 2 <----+
129
+
v |
130
+
0(finish) ------> 1(start)
131
+
^ |
132
+
+------- 3 <----+ *)
133
+
134
+
let g, v = Classic.cycle 3
135
+
let v3 = V.create 3
136
+
let () = add_vertex g v3; add_edge g v.(1) v3; add_edge g v3 v.(0)
137
+
let _, c = Eulerian.path g
138
+
let () = assert (not c)
139
+
140
+