The unpac monorepo manager self-hosting as a monorepo using unpac
Eulerian: cleaning up, documentation
+31
-16
+31
-16
src/eulerian.ml
+31
-16
src/eulerian.ml
···
23
23
val iter_edges_e : (E.t -> unit) -> t -> unit
24
24
end
25
25
26
+
(** The following implements Hierholzer's algorithm.
27
+
28
+
It is sketched as follows:
29
+
30
+
1. make a round trip from a random vertex, by following random
31
+
edges until we get back to the starting point (it will, as we
32
+
first check that all vertices have even degrees).
33
+
34
+
2. if any vertex along this cycle still has outgoing edges, pick one
35
+
and make another round trip from it, and then join the two cycles
36
+
into a single one. Repeat step 2 until all edges are exhausted.
37
+
38
+
The implementation makes use of the following:
39
+
40
+
- A table, called `out` in the following, that maps each vertex to
41
+
outgoing edges not yet used in the Eulerian path.
42
+
43
+
- In order to achieve optimal complexity, paths are built as
44
+
doubly-linked lists, so that we can merge two cycles with a common
45
+
vertex in constant time. This is type `dll` below.
46
+
*)
47
+
26
48
module Make(G: G) = struct
27
49
28
50
open G
···
32
54
33
55
module H = Hashtbl.Make(V)
34
56
35
-
let setup g =
57
+
type out = E.t H.t H.t
58
+
59
+
(** compute the table of outgoing edges *)
60
+
let setup g : int * out =
36
61
let nbe = ref 0 in
37
62
let out = H.create 16 in
38
63
let add h x y e =
···
53
78
try H.iter (fun v _ -> raise (Found v)) h; assert false
54
79
with Found v -> v, H.find h v
55
80
56
-
(** in order to achieve optimal complexity, paths are built as
57
-
doubly-linked lists, so that we can merge two cycles with a
58
-
common vertex in constant time *)
59
81
type dll = { mutable prev: dll; edge: E.t; mutable next: dll }
60
82
61
83
let remove_edge out e =
62
-
(* Format.eprintf "remove_edge %a@." print_edge e; *)
63
84
let remove h x y =
64
85
let s = H.find h x in
65
86
assert (H.mem s y);
···
82
103
remove_edge out e;
83
104
e
84
105
85
-
(** builds an arbitrary cycle from [start] *)
106
+
(** build an arbitrary cycle from vertex [start] *)
86
107
let round_trip edges start =
87
108
let e = any_out_edge edges start in
88
109
let rec path = { prev = path; edge = e; next = path } in
···
102
123
e.next <- e';
103
124
e'.prev <- e
104
125
105
-
(** builds an Eulerian cycle from [v] *)
126
+
(** build an Eulerian cycle from vertex [start] *)
106
127
let eulerian_cycle out start =
107
-
(* Format.eprintf "eulerian_cycle from start=%a@." print_vertex start; *)
108
128
let todos = H.create 8 in (* vertex on cycle with out edges -> cycle edge *)
109
129
let todo e =
110
130
let v = E.src e.edge in
···
114
134
if not (V.equal (E.dst e.edge) start) then update start e.next in
115
135
let path = round_trip out start in
116
136
update start path;
117
-
(* H.iter (fun v s -> eprintf " out %a = %d@." print_vertex v (H.length s)) out;
118
-
* eprintf " %d todos@." (H.length todos); *)
119
137
while H.length todos > 0 do
120
138
let v, e = any todos in
121
-
(* Format.eprintf " add cycle from %a@." print_vertex v; *)
122
139
H.remove todos v;
123
140
assert (H.mem out v);
124
141
let e' = round_trip out v in
125
142
update v e';
126
-
(* H.iter (fun v s -> eprintf " out %a = %d@." print_vertex v (H.length s)) out;
127
-
* eprintf " %d todos@." (H.length todos); *)
128
143
let p = e.prev in
129
144
assert (p.next == e);
130
145
let p' = e'.prev in
···
174
189
| _, 0 -> rev xy :: list_of (eulerian_cycle out x)
175
190
| 0, _ -> xy :: list_of (eulerian_cycle out y)
176
191
| _ ->
177
-
(* a bit of a pity to use list concatenation, but this
178
-
does not change the complexity *)
192
+
(* a bit of a pity to use list concatenation here,
193
+
but this does not change the complexity *)
179
194
list_of (eulerian_cycle out x) @
180
195
xy :: list_of (eulerian_cycle out y)
181
196
) else (
···
185
200
H.add (H.find out x) y xy;
186
201
H.add (H.find out y) x (rev xy);
187
202
let p = eulerian_cycle out x in
188
-
let rec find e =
203
+
let rec find e = (* lookup for x--y, to break the cycle there *)
189
204
let v = E.src e.edge and w = E.dst e.edge in
190
205
if V.equal v x && V.equal w y ||
191
206
V.equal v y && V.equal w x then e else find e.next in