The unpac monorepo manager self-hosting as a monorepo using unpac
Traverse.Bfs: traversal with distance from the source
two new functions {fold,iter}_component_dist to perform a breadth-first
search from a source, and visit each vertex with the distance from
the source
+99
+3
CHANGES.md
+3
CHANGES.md
+25
src/traverse.ml
+25
src/traverse.ml
···
278
278
279
279
let iter_component f = fold_component (fun v () -> f v) ()
280
280
281
+
(* with distance from the source
282
+
283
+
instead of using a queue, we use two bags
284
+
(`todo` with vertices at distance `d`
285
+
and `next` with vertices at distance `d+1`*)
286
+
287
+
let fold_component_dist f acc g v0 =
288
+
let h = H.create 97 in
289
+
(* invariant: [h] contains exactly the vertices
290
+
which have been pushed *)
291
+
let push v next =
292
+
if H.mem h v then next
293
+
else (H.add h v (); v :: next) in
294
+
let rec loop acc d next = function
295
+
| [] -> if next = [] then acc
296
+
else loop acc (d+1) [] next
297
+
| v :: todo ->
298
+
let acc = f v d acc in
299
+
let next = G.fold_succ push g v next in
300
+
loop acc d next todo in
301
+
loop acc 0 [] (push v0 [])
302
+
303
+
let iter_component_dist f =
304
+
fold_component_dist (fun v d () -> f v d) ()
305
+
281
306
(* step-by-step iterator *)
282
307
283
308
(* simple, yet O(1)-amortized, persistent queues *)
+6
src/traverse.mli
+6
src/traverse.mli
···
134
134
val fold_component : (G.V.t -> 'a -> 'a) -> 'a -> G.t -> G.V.t -> 'a
135
135
(** Idem, but limited to a single root vertex. *)
136
136
137
+
(** {2 With the distance to the source} *)
138
+
139
+
val fold_component_dist : (G.V.t -> int -> 'a -> 'a) -> 'a -> G.t -> G.V.t -> 'a
140
+
141
+
val iter_component_dist : (G.V.t -> int -> unit) -> G.t -> G.V.t -> unit
142
+
137
143
(** {2 Step-by-step iterator}
138
144
See module [Dfs] *)
139
145
+5
tests/dune
+5
tests/dune
+60
tests/test_bfs.ml
+60
tests/test_bfs.ml
···
1
+
2
+
(* 0
3
+
/ \
4
+
/ \
5
+
v v
6
+
1---2---3 (All edges are undirected,
7
+
|\ /| apart from 0->1 0->3 1->5 and 3->6.)
8
+
| \ / |
9
+
| 4 |
10
+
| / \ |
11
+
v / \ v
12
+
5 6
13
+
*)
14
+
15
+
open Format
16
+
open Graph
17
+
open Pack.Digraph
18
+
19
+
let debug = false
20
+
21
+
let g = create ()
22
+
let v = Array.init 7 V.create
23
+
let () = Array.iter (add_vertex g) v
24
+
let adde x y = add_edge g v.(x) v.(y)
25
+
let addu x y = adde x y; adde y x
26
+
let () = adde 0 1; adde 0 3
27
+
let () = addu 1 2; addu 2 3
28
+
let () = adde 1 5; adde 3 6
29
+
let () = addu 1 4; addu 4 3; addu 5 4; addu 4 6
30
+
31
+
module B = Traverse.Bfs(Pack.Digraph)
32
+
33
+
let dist = Array.make 7 (-1)
34
+
let reset () = Array.fill dist 0 7 (-1)
35
+
let mark v d =
36
+
let i = V.label v in
37
+
(* eprintf "visit %d at distance %d@." i d; *)
38
+
assert (dist.(i) = -1); (* visit at most once *)
39
+
dist.(i) <- d
40
+
41
+
let test s dl =
42
+
reset ();
43
+
B.iter_component_dist mark g v.(s);
44
+
List.iter (fun (d, vl) ->
45
+
List.iter (fun v -> assert (dist.(v) = d)) vl) dl
46
+
47
+
let () = test 0 [0, [0];
48
+
1, [1;3];
49
+
2, [2;4;5;6]; ]
50
+
let () = test 2 [-1, [0];
51
+
0, [2];
52
+
1, [1;3];
53
+
2, [4;5;6]; ]
54
+
let () = test 5 [-1, [0];
55
+
0, [5];
56
+
1, [4];
57
+
2, [1;3;6];
58
+
3, [2]; ]
59
+
60
+
let () = printf "All tests succeeded.@."