The unpac monorepo manager self-hosting as a monorepo using unpac
Eulerian paths, using Hierholzer's algorithm
+370
-1
+2
-1
CHANGES.md
+2
-1
CHANGES.md
+212
src/eulerian.ml
+212
src/eulerian.ml
···
1
+
(**************************************************************************)
2
+
(* *)
3
+
(* Ocamlgraph: a generic graph library for OCaml *)
4
+
(* Copyright (C) 2004-2010 *)
5
+
(* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles *)
6
+
(* *)
7
+
(* This software is free software; you can redistribute it and/or *)
8
+
(* modify it under the terms of the GNU Library General Public *)
9
+
(* License version 2.1, with the special exception on linking *)
10
+
(* described in file LICENSE. *)
11
+
(* *)
12
+
(* This software is distributed in the hope that it will be useful, *)
13
+
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
14
+
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
15
+
(* *)
16
+
(**************************************************************************)
17
+
18
+
module type G = sig
19
+
type t
20
+
val is_directed : bool
21
+
module V : Sig.COMPARABLE
22
+
module E : Sig.EDGE with type vertex = V.t
23
+
val iter_edges_e : (E.t -> unit) -> t -> unit
24
+
end
25
+
26
+
module Make(G: G) = struct
27
+
28
+
open G
29
+
30
+
let rev e =
31
+
E.create (E.dst e) (E.label e) (E.src e)
32
+
33
+
module H = Hashtbl.Make(V)
34
+
35
+
let setup g =
36
+
let nbe = ref 0 in
37
+
let out = H.create 16 in
38
+
let add h x y e =
39
+
let s = try H.find h x
40
+
with Not_found -> let s = H.create 4 in H.add h x s; s in
41
+
if H.mem s y then invalid_arg "Eulerian.path (multigraphs not allowed)";
42
+
H.add s y e in
43
+
let add e =
44
+
incr nbe;
45
+
let x = E.src e and y = E.dst e in
46
+
add out x y e;
47
+
if not is_directed && not (V.equal x y) then add out y x (rev e) in
48
+
iter_edges_e add g;
49
+
!nbe, out
50
+
51
+
exception Found of V.t
52
+
let any h =
53
+
try H.iter (fun v _ -> raise (Found v)) h; assert false
54
+
with Found v -> v, H.find h v
55
+
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
+
type dll = { mutable prev: dll; edge: E.t; mutable next: dll }
60
+
61
+
let remove_edge out e =
62
+
(* Format.eprintf "remove_edge %a@." print_edge e; *)
63
+
let remove h x y =
64
+
let s = H.find h x in
65
+
assert (H.mem s y);
66
+
H.remove s y;
67
+
if H.length s = 0 then H.remove h x in
68
+
let v = E.src e and w = E.dst e in
69
+
remove out v w
70
+
71
+
let self e = V.equal (E.src e) (E.dst e)
72
+
73
+
let remove_edge edges e =
74
+
remove_edge edges e;
75
+
if not is_directed && not (self e) then remove_edge edges (rev e)
76
+
77
+
let any_out_edge out v =
78
+
assert (H.mem out v);
79
+
let s = H.find out v in
80
+
assert (H.length s > 0);
81
+
let _, e = any s in
82
+
remove_edge out e;
83
+
e
84
+
85
+
(** builds an arbitrary cycle from [start] *)
86
+
let round_trip edges start =
87
+
let e = any_out_edge edges start in
88
+
let rec path = { prev = path; edge = e; next = path } in
89
+
let rec tour e =
90
+
let v = E.dst e.edge in
91
+
if V.equal v start then (
92
+
path.prev <- e;
93
+
path
94
+
) else (
95
+
let e' = { prev = e; edge = any_out_edge edges v; next = path } in
96
+
e.next <- e';
97
+
tour e'
98
+
) in
99
+
tour path
100
+
101
+
let connect e e' =
102
+
e.next <- e';
103
+
e'.prev <- e
104
+
105
+
(** builds an Eulerian cycle from [v] *)
106
+
let eulerian_cycle out start =
107
+
(* Format.eprintf "eulerian_cycle from start=%a@." print_vertex start; *)
108
+
let todos = H.create 8 in (* vertex on cycle with out edges -> cycle edge *)
109
+
let todo e =
110
+
let v = E.src e.edge in
111
+
if H.mem out v then H.replace todos v e else H.remove todos v in
112
+
let rec update start e =
113
+
todo e;
114
+
if not (V.equal (E.dst e.edge) start) then update start e.next in
115
+
let path = round_trip out start in
116
+
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
+
while H.length todos > 0 do
120
+
let v, e = any todos in
121
+
(* Format.eprintf " add cycle from %a@." print_vertex v; *)
122
+
H.remove todos v;
123
+
assert (H.mem out v);
124
+
let e' = round_trip out v in
125
+
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
+
let p = e.prev in
129
+
assert (p.next == e);
130
+
let p' = e'.prev in
131
+
assert (p'.next == e');
132
+
connect p e';
133
+
connect p' e;
134
+
done;
135
+
path
136
+
137
+
let list_of path =
138
+
let rec convert acc e =
139
+
if e == path then List.rev acc else convert (e.edge :: acc) e.next in
140
+
convert [path.edge] path.next
141
+
142
+
let mem_edge out x y =
143
+
try H.mem (H.find out x) y with Not_found -> false
144
+
145
+
let out_degree out x =
146
+
try H.length (H.find out x) with Not_found -> 0
147
+
148
+
let undirected g =
149
+
let nbe, out = setup g in
150
+
let odds = H.create 2 in
151
+
let check v s =
152
+
let d = H.length s in
153
+
let d = if H.mem s v then d - 1 else d in
154
+
if d mod 2 = 1 then H.add odds v () in
155
+
H.iter check out;
156
+
let n = H.length odds in
157
+
if n <> 0 && n <> 2 then invalid_arg "Eulerian.path (bad degrees)";
158
+
let cycle = n = 0 in
159
+
let path =
160
+
if cycle then
161
+
if nbe = 0 then []
162
+
else let v, _ = any out in list_of (eulerian_cycle out v)
163
+
else (
164
+
(* we have two vertices x and y with odd degrees *)
165
+
let x, _ = any odds in
166
+
H.remove odds x;
167
+
let y, _ = any odds in
168
+
if mem_edge out x y then (
169
+
(* there is an edge x--y => it connects two Eulerian cycles *)
170
+
let xy = H.find (H.find out x) y in
171
+
remove_edge out xy;
172
+
match out_degree out x, out_degree out y with
173
+
| 0, 0 -> [xy]
174
+
| _, 0 -> rev xy :: list_of (eulerian_cycle out x)
175
+
| 0, _ -> xy :: list_of (eulerian_cycle out y)
176
+
| _ ->
177
+
(* a bit of a pity to use list concatenation, but this
178
+
does not change the complexity *)
179
+
list_of (eulerian_cycle out x) @
180
+
xy :: list_of (eulerian_cycle out y)
181
+
) else (
182
+
(* no edge x--y => add one, build a cycle, then remove it *)
183
+
let dummy = E.label (snd (any (H.find out x))) in
184
+
let xy = E.create x dummy y in
185
+
H.add (H.find out x) y xy;
186
+
H.add (H.find out y) x (rev xy);
187
+
let p = eulerian_cycle out x in
188
+
let rec find e =
189
+
let v = E.src e.edge and w = E.dst e.edge in
190
+
if V.equal v x && V.equal w y ||
191
+
V.equal v y && V.equal w x then e else find e.next in
192
+
let start = find p in
193
+
List.tl (list_of start)
194
+
)
195
+
)
196
+
in
197
+
(* check that all edges have been consumed *)
198
+
if H.length out > 0 then invalid_arg "Eulerian.path (not connected)";
199
+
path, cycle
200
+
201
+
let directed _g =
202
+
invalid_arg "Eulerian.path (directed graphs not yet supported)"
203
+
204
+
let path g =
205
+
if is_directed then directed g else undirected g
206
+
207
+
let cycle g =
208
+
let p, c = path g in
209
+
if not c then invalid_arg "Eulerian.cycle";
210
+
p
211
+
212
+
end
+47
src/eulerian.mli
+47
src/eulerian.mli
···
1
+
(**************************************************************************)
2
+
(* *)
3
+
(* Ocamlgraph: a generic graph library for OCaml *)
4
+
(* Copyright (C) 2004-2010 *)
5
+
(* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles *)
6
+
(* *)
7
+
(* This software is free software; you can redistribute it and/or *)
8
+
(* modify it under the terms of the GNU Library General Public *)
9
+
(* License version 2.1, with the special exception on linking *)
10
+
(* described in file LICENSE. *)
11
+
(* *)
12
+
(* This software is distributed in the hope that it will be useful, *)
13
+
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
14
+
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
15
+
(* *)
16
+
(**************************************************************************)
17
+
18
+
(** Eulerian path
19
+
20
+
This module implements Hierholzer's algorithm, with O(E) complexity
21
+
where E is the number of edges.
22
+
23
+
Limitations:
24
+
- multigraphs are not supported
25
+
- directed graphs not yet supported
26
+
*)
27
+
28
+
module type G = sig
29
+
type t
30
+
val is_directed : bool
31
+
module V : Sig.COMPARABLE
32
+
module E : Sig.EDGE with type vertex = V.t
33
+
val iter_edges_e : (E.t -> unit) -> t -> unit
34
+
end
35
+
36
+
module Make(G: G) : sig
37
+
38
+
val path: G.t -> G.E.t list * bool
39
+
(** [path g] returns an Eulerian path of [g]. The Boolean indicates
40
+
whether the path is a cycle. Raises [Invalid_argument] if there
41
+
is no Eulerian path. *)
42
+
43
+
val cycle: G.t -> G.E.t list
44
+
(** [cycle g] returns an Eulerian cycle of [g].
45
+
Raises [Invalid_argument] if there is no Eulerian cycle. *)
46
+
47
+
end
+4
src/pack.ml
+4
src/pack.ml
+10
src/sig_pack.mli
+10
src/sig_pack.mli
···
409
409
val iter_stable : (V.t -> unit) -> t -> unit
410
410
end
411
411
412
+
(** Eulerian path *)
413
+
module Eulerian : sig
414
+
val path: t -> E.t list * bool
415
+
(** [path g] returns an Eulerian path of g. The Boolean indicates
416
+
whether the path is a cycle. Raises [Invalid_argument] if there is
417
+
no Eulerian path. *)
418
+
419
+
val cycle: t -> E.t list
420
+
end
421
+
412
422
val spanningtree : t -> E.t list
413
423
(** Kruskal algorithm *)
414
424
+5
tests/dune
+5
tests/dune
+90
tests/test_eulerian.ml
+90
tests/test_eulerian.ml
···
1
+
2
+
open Format
3
+
open Graph
4
+
5
+
open Pack.Graph
6
+
7
+
let print_vertex fmt v =
8
+
fprintf fmt "%d" (V.label v)
9
+
let print_edge fmt e =
10
+
fprintf fmt "%a->%a" print_vertex (E.src e) print_vertex (E.dst e)
11
+
let print_path fmt p =
12
+
List.iter (fun e -> fprintf fmt "%a " print_edge e) p
13
+
14
+
module G = Pack.Graph
15
+
16
+
let exists_path g =
17
+
try ignore (Eulerian.path g); true with Invalid_argument _ -> false
18
+
let exists_cycle g =
19
+
try ignore (Eulerian.cycle g); true with Invalid_argument _ -> false
20
+
21
+
let g = create ()
22
+
let add_vertex i = let v = V.create i in add_vertex g v; v
23
+
let path_length g = let p, _ = Eulerian.path g in List.length p
24
+
25
+
let v0 = add_vertex 0
26
+
let () = assert (exists_path g)
27
+
let () = assert (exists_cycle g)
28
+
29
+
let v1 = add_vertex 1
30
+
let () = assert (exists_path g)
31
+
let () = assert (exists_cycle g)
32
+
33
+
let () = add_edge g v0 v1
34
+
let () = assert (exists_path g)
35
+
let () = assert (not (exists_cycle g))
36
+
let () = assert (path_length g = 1)
37
+
38
+
let v2 = add_vertex 2
39
+
let () = add_edge g v1 v2
40
+
let () = assert (exists_path g)
41
+
let () = assert (not (exists_cycle g))
42
+
let () = assert (path_length g = 2)
43
+
44
+
let () = add_edge g v2 v0
45
+
let p, c = Eulerian.path g
46
+
let () = assert (exists_path g)
47
+
let () = assert (exists_cycle g)
48
+
let () = assert (path_length g = 3)
49
+
50
+
let () = add_edge g v0 v0
51
+
let () = assert (exists_cycle g)
52
+
53
+
let v3 = add_vertex 3
54
+
let () = add_edge g v2 v3
55
+
let () = assert (exists_path g)
56
+
let () = assert (not (exists_cycle g))
57
+
let () = assert (path_length g = 5)
58
+
59
+
let v4 = add_vertex 4
60
+
let () = add_edge g v3 v4
61
+
let () = add_edge g v2 v4
62
+
let () = assert (exists_cycle g)
63
+
let () = assert (path_length g = 7)
64
+
65
+
let () = remove_edge g v2 v4
66
+
let v5 = add_vertex 5
67
+
let () = add_edge g v4 v5
68
+
let () = add_edge g v5 v3
69
+
let () = assert (exists_path g)
70
+
let () = assert (not (exists_cycle g))
71
+
let () = assert (path_length g = 8)
72
+
73
+
let () = remove_edge g v2 v3 (* not connected anymore *)
74
+
let () = assert (not (exists_path g))
75
+
76
+
let () =
77
+
for n = 2 to 5 do
78
+
let g = Classic.full ~self:false (2*n) in
79
+
assert (not (exists_path g));
80
+
let g = Classic.full ~self:true (2*n) in
81
+
assert (not (exists_path g));
82
+
let g = Classic.full ~self:false (2*n+1) in
83
+
let p, c = Eulerian.path g in
84
+
assert c;
85
+
assert (List.length p = n*(2*n+1));
86
+
let g = Classic.full ~self:true (2*n+1) in
87
+
let p, c = Eulerian.path g in
88
+
assert c;
89
+
assert (List.length p = (n+1)*(2*n+1))
90
+
done