Skip to content

Commit 5dcb7a4

Browse files
backtrackingbacktracking
authored
Merge pull request #152 from backtracking/bfs01
0-1 BFS
2 parents 1b052ff + 37cda77 commit 5dcb7a4

File tree

9 files changed

+238
-2
lines changed

9 files changed

+238
-2
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11

2+
- [Path]: new module [Bfs01] to implement 0-1 BFS
23
- [Classic] new functions [kneser] and [petersen] to build Kneser's
34
graphs and the Petersen graph
45
- [Oper] fixed transitive reduction (#145, reported by sim642)

‎src/lib/deque.ml‎

Lines changed: 108 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
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+
(** Double-ended queue implemented with doubly-linked lists *)
19+
20+
type 'a cell =
21+
| Null
22+
| Cell of { value: 'a; mutable prev: 'a cell; mutable next: 'a cell; }
23+
24+
type 'a t = {
25+
mutable front: 'a cell;
26+
mutable back : 'a cell;
27+
mutable size : int;
28+
}
29+
(* invariant: size=0 && front=back == Null
30+
|| size>0 && front,back != Null
31+
32+
----next--->
33+
front back
34+
<---prev----
35+
*)
36+
37+
let create () =
38+
{ front = Null; back = Null; size = 0 }
39+
40+
let length dq =
41+
dq.size
42+
43+
let clear dq =
44+
dq.front <- Null;
45+
dq.back <- Null;
46+
dq.size <- 0
47+
48+
let add_first dq x =
49+
let c = Cell { value = x; prev = Null; next = Null } in
50+
dq.front <- c;
51+
dq.back <- c;
52+
dq.size <- 1
53+
54+
let push_front dq x =
55+
match dq.front with
56+
| Null ->
57+
add_first dq x
58+
| Cell f as cf ->
59+
let c = Cell { value = x; prev = Null; next = cf } in
60+
f.prev <- c;
61+
dq.front <- c;
62+
dq.size <- dq.size + 1
63+
64+
let peek_front dq =
65+
match dq.front with
66+
| Null -> invalid_arg "peek_front"
67+
| Cell { value=v; _ } -> v
68+
69+
let pop_front dq =
70+
match dq.front with
71+
| Null ->
72+
invalid_arg "pop_front"
73+
| Cell { value=v; next=Null; _} ->
74+
clear dq;
75+
v
76+
| Cell { value=v; next=Cell c as n; _} ->
77+
dq.front <- n;
78+
c.prev <- Null;
79+
dq.size <- dq.size - 1;
80+
v
81+
82+
let push_back dq x =
83+
match dq.back with
84+
| Null ->
85+
add_first dq x
86+
| Cell b as cb ->
87+
let c = Cell { value = x; prev = cb; next = Null } in
88+
b.next <- c;
89+
dq.back <- c;
90+
dq.size <- dq.size + 1
91+
92+
let peek_back dq =
93+
match dq.back with
94+
| Null -> invalid_arg "peek_back"
95+
| Cell { value=v; _ } -> v
96+
97+
let pop_back dq =
98+
match dq.back with
99+
| Null ->
100+
invalid_arg "pop_back"
101+
| Cell { value=v; prev=Null; _} ->
102+
clear dq;
103+
v
104+
| Cell { value=v; prev=Cell c as p; _} ->
105+
dq.back <- p;
106+
c.next <- Null;
107+
dq.size <- dq.size - 1;
108+
v

‎src/lib/deque.mli‎

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
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+
(** Double-ended queue *)
19+
20+
type 'a t
21+
22+
val create: unit -> 'a t
23+
val length: 'a t -> int
24+
25+
val clear: 'a t -> unit
26+
27+
val push_front: 'a t -> 'a -> unit
28+
val peek_front: 'a t -> 'a
29+
val pop_front: 'a t -> 'a
30+
31+
val push_back: 'a t -> 'a -> unit
32+
val peek_back: 'a t -> 'a
33+
val pop_back: 'a t -> 'a

‎src/pack.ml‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,9 @@ struct
5959
module BF = Path.BellmanFord(G)(W)
6060
let bellman_ford = BF.find_negative_cycle_from
6161

62+
module Bfs01 = Path.Bfs01(G)
63+
let bfs_0_1 = Bfs01.iter
64+
6265
module F = struct
6366
type label = int
6467
type t = int

‎src/path.ml‎

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -347,3 +347,36 @@ struct
347347
loop ()
348348

349349
end
350+
351+
(** 0-1 BFS
352+
353+
When edge weights are limited to 0 or 1, this is more efficient than
354+
running Dijkstra's algorithm. *)
355+
356+
module Bfs01(G: sig
357+
type t
358+
module V: Sig.COMPARABLE
359+
module E: sig type t val dst : t -> V.t end
360+
val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit
361+
end) = struct
362+
363+
module H = Hashtbl.Make(G.V)
364+
365+
let iter f g ~zero s =
366+
let visited = H.create 16 in
367+
let d = Deque.create () in
368+
Deque.push_front d (s, 0); H.add visited s ();
369+
while Deque.length d > 0 do
370+
let v, n = Deque.pop_front d in
371+
f v n;
372+
G.iter_succ_e (fun e ->
373+
let w = G.E.dst e in
374+
if not (H.mem visited w) then (
375+
H.add visited w ();
376+
if zero e then Deque.push_front d (w, n )
377+
else Deque.push_back d (w, n+1)
378+
)
379+
) g v
380+
done
381+
382+
end

‎src/path.mli‎

Lines changed: 23 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,6 @@
1515
(* *)
1616
(**************************************************************************)
1717

18-
(* $Id: path.mli,v 1.9 2005-07-18 07:10:35 filliatr Exp $ *)
19-
2018
(** Paths *)
2119

2220
(** Minimal graph signature for Dijkstra's algorithm.
@@ -152,3 +150,26 @@ sig
152150
*)
153151

154152
end
153+
154+
(** 0-1 BFS
155+
156+
When edge weights are limited to 0 or 1, this is more efficient than
157+
running Dijkstra's algorithm. It runs in time and space O(E) in
158+
the worst case. *)
159+
160+
module Bfs01(G: sig
161+
type t
162+
module V: Sig.COMPARABLE
163+
module E: sig type t val dst : t -> V.t end
164+
val iter_succ_e : (E.t -> unit) -> t -> V.t -> unit
165+
end) : sig
166+
167+
val iter: (G.V.t -> int -> unit) ->
168+
G.t -> zero:(G.E.t -> bool) -> G.V.t -> unit
169+
(** [iter f g zero s] performs a 0-1 BFS on graph [g], from the
170+
source vertex [s], and applies [f] to each visited vertex and
171+
its distance from the source. Function [zero] indicates 0-edges.
172+
All reachable vertices are visited, in increasing order of
173+
distance to the source. *)
174+
175+
end

‎src/sig_pack.mli‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -419,6 +419,9 @@ module type S = sig
419419
(** [bellman_ford g v] finds a negative cycle from [v], and returns it,
420420
or raises [Not_found] if there is no such cycle *)
421421

422+
val bfs_0_1: (V.t -> int -> unit) -> t -> zero:(E.t -> bool) -> V.t -> unit
423+
(** 0-1 BFS from a given source. Function [zero] indicates 0-edges. *)
424+
422425
(** Path checking *)
423426
module PathCheck : sig
424427
type path_checker

‎tests/dune‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,11 @@
2323
(libraries graph)
2424
(modules test_topsort))
2525

26+
(test
27+
(name test_bfs01)
28+
(libraries graph)
29+
(modules test_bfs01))
30+
2631
(test
2732
(name test_check_path)
2833
(libraries graph)

‎tests/test_bfs01.ml‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
2+
(* Test file for Path.Bfs01 *)
3+
4+
open Graph
5+
open Pack.Digraph
6+
7+
let zero e =
8+
E.label e = 0
9+
10+
let test n =
11+
let g = create () in
12+
let nv = 2*n+2 in
13+
let v = Array.init nv V.create in
14+
Array.iter (add_vertex g) v;
15+
let edge i d j = add_edge_e g (E.create v.(i) d v.(j)) in
16+
for i = 1 to n do let i = 2*i in edge (i-2) 0 i done; edge (2*n) 1 (2*n+1);
17+
edge 0 1 1; for i = 0 to n-1 do let i = 2*i+1 in edge i 1 (i+2) done;
18+
let check v d =
19+
let i = V.label v in
20+
assert (d = if i mod 2 = 0 then 0
21+
else if i = 2*n+1 then 1
22+
else (i+1) / 2) in
23+
bfs_0_1 check g ~zero v.(0)
24+
25+
let () =
26+
for n = 0 to 10 do test n done
27+
28+
29+

0 commit comments

Comments
 (0)