diff --git a/CHANGES.md b/CHANGES.md index 8e837f34..ea216312 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,9 @@ +# 2.1.0 (August 30, 2023) + + - :exclamation: OCamlGraph now requires OCaml >= 4.08 + - :exclamation: [Traverse]: fixed [Dfs.fold] and [Dfs.fold_component], + which were not implementing a proper DFS - [Classic]: new functions [cycle] and [grid] - [Eulerian]: Eulerian paths (new module) - [Components]: strong articulation points (see functors [Connectivity] diff --git a/ocamlgraph.opam b/ocamlgraph.opam index 360f530d..9f1cf44b 100644 --- a/ocamlgraph.opam +++ b/ocamlgraph.opam @@ -1,7 +1,7 @@ opam-version: "2.0" synopsis: "A generic graph library for OCaml" description: "Provides both graph data structures and graph algorithms" -maintainer: ["filliatr@lri.fr"] +maintainer: ["jean-christophe.filliatre@cnrs.fr"] authors: ["Sylvain Conchon" "Jean-Christophe FilliĆ¢tre" "Julien Signoles"] license: "LGPL-2.1-only" tags: [ @@ -18,13 +18,13 @@ homepage: "https://github.com/backtracking/ocamlgraph/" doc: "https://backtracking.github.io/ocamlgraph" bug-reports: "https://github.com/backtracking/ocamlgraph/issues/new" depends: [ - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.08.0"} "stdlib-shims" "dune" {>= "2.0"} "graphics" {with-test} ] build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} [ "dune" "build" diff --git a/ocamlgraph_gtk.opam b/ocamlgraph_gtk.opam index 07998e5e..6c8e8206 100644 --- a/ocamlgraph_gtk.opam +++ b/ocamlgraph_gtk.opam @@ -1,7 +1,7 @@ opam-version: "2.0" synopsis: "Displaying graphs using OCamlGraph and GTK" description: "Displaying graphs using OCamlGraph and GTK" -maintainer: ["filliatr@lri.fr"] +maintainer: ["jean-christophe.filliatre@cnrs.fr"] authors: ["Sylvain Conchon" "Jean-Christophe FilliĆ¢tre" "Julien Signoles"] license: "LGPL-2.1-only" tags: [ @@ -18,7 +18,7 @@ homepage: "https://github.com/backtracking/ocamlgraph/" doc: "https://backtracking.github.io/ocamlgraph" bug-reports: "https://github.com/backtracking/ocamlgraph/issues/new" depends: [ - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.08.0"} "stdlib-shims" "lablgtk" "conf-gnomecanvas" @@ -27,7 +27,7 @@ depends: [ "graphics" {with-test} ] build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} [ "dune" "build" diff --git a/src/cycles.ml b/src/cycles.ml index ea89305a..99a3ce12 100644 --- a/src/cycles.ml +++ b/src/cycles.ml @@ -14,7 +14,7 @@ struct exception Stuck of G.vertex list - module IM = Map.Make (Int) + module IM = Map.Make (struct type t = int let compare = Stdlib.compare end) module VM = Map.Make (G.V) module VS = Set.Make (G.V) @@ -187,6 +187,7 @@ struct of an obligatory arc. Use the "unbalanced" heuristic impllemented in [takemax] to discriminate between competing possibilities. If a vertex is found, remove it from the returned delta bins. *) +(* let max_from_deltas g ({ delta_bins; _ } as st) = let rec f = function | Seq.Nil -> None @@ -196,6 +197,18 @@ struct | Some (_, v) -> Some (v, remove_from_bin v st)) in f (IM.to_rev_seq delta_bins ()) +*) + let max_from_deltas g ({ delta_bins; _ } as st) = + let rec f im = + if IM.is_empty im then + None + else + let k, dbin = IM.max_binding im in + (match VS.fold (takemax g) dbin None with + | None -> f (IM.remove k im) + | Some (_, v) -> Some (v, remove_from_bin v st)) + in + f delta_bins (* Include any leftward arcs due to the two-cycles that were removed by preprocessing. *) diff --git a/src/traverse.ml b/src/traverse.ml index 79eb4517..c7eac4ed 100644 --- a/src/traverse.ml +++ b/src/traverse.ml @@ -31,22 +31,23 @@ end module Dfs(G : G) = struct module H = Hashtbl.Make(G.V) - let fold f i g = + let fold f acc g = let h = H.create 97 in let s = Stack.create () in - let push v = - if not (H.mem h v) then begin H.add h v (); Stack.push v s end - in let rec loop acc = if not (Stack.is_empty s) then let v = Stack.pop s in - let ns = f v acc in - G.iter_succ push g v; - loop ns + if not (H.mem h v) then begin + H.add h v (); + let acc = f v acc in + G.iter_succ (fun w -> Stack.push w s) g v; + loop acc + end else + loop acc else acc in - G.fold_vertex (fun v s -> push v; loop s) g i + G.fold_vertex (fun v acc -> Stack.push v s; loop acc) g acc let iter ?(pre=fun _ -> ()) ?(post=fun _ -> ()) g = let h = H.create 97 in @@ -62,24 +63,24 @@ module Dfs(G : G) = struct let postfix post g = iter ~post g - let fold_component f i g v0 = + let fold_component f acc g v0 = let h = H.create 97 in let s = Stack.create () in - (* invariant: [h] contains exactly the vertices which have been pushed *) - let push v = - if not (H.mem h v) then begin H.add h v (); Stack.push v s end - in - push v0; + Stack.push v0 s; let rec loop acc = if not (Stack.is_empty s) then let v = Stack.pop s in - let ns = f v acc in - G.iter_succ push g v; - loop ns + if not (H.mem h v) then begin + H.add h v (); + let acc = f v acc in + G.iter_succ (fun w -> Stack.push w s) g v; + loop acc + end else + loop acc else acc in - loop i + loop acc let iter_component ?(pre=fun _ -> ()) ?(post=fun _ -> ()) g v = let h = H.create 97 in diff --git a/tests/dune b/tests/dune index 8f27157a..f81bb32c 100644 --- a/tests/dune +++ b/tests/dune @@ -3,6 +3,11 @@ (libraries graph) (modules check)) +(test + (name test_dfs) + (libraries graph) + (modules test_dfs)) + (test (name test_topsort) (libraries graph) diff --git a/tests/test_components.expected b/tests/test_components.expected index dd46d104..ea543a27 100644 --- a/tests/test_components.expected +++ b/tests/test_components.expected @@ -1,11 +1,9 @@ -7 components +4 components 0 -> 0 1 -> 1 -2 -> 2 -3 -> 3 -4 -> 1 -5 -> 1 -6 -> 4 -7 -> 1 -8 -> 5 -9 -> 6 +2 -> 0 +3 -> 2 +4 -> 2 +5 -> 3 +6 -> 2 +7 -> 0 diff --git a/tests/test_components.ml b/tests/test_components.ml index f052a57e..2141d6b5 100644 --- a/tests/test_components.ml +++ b/tests/test_components.ml @@ -22,16 +22,20 @@ module C = Components.Undirected(Pack.Graph) open Pack.Graph +(* 0 -- 2 -- 7 1 3 -- 4 5 + \ / + 6 + +component: 0 1 2 3 +*) + let () = - Random.init 42; - let g = Rand.graph ~v:10 ~e:3 () in + let g = create () in + let v = Array.init 8 V.create in + Array.iter (add_vertex g) v; + let add i j = add_edge g v.(i) v.(j) in + add 0 2; add 7 2; add 3 4; add 4 6; add 3 6; let n, f = C.components g in printf "%d components@." n; iter_vertex (fun v -> printf "%d -> %d@." (V.label v) (f v)) g - -(* -Local Variables: -compile-command: "ocaml -I .. graph.cma test_components.ml" -End: -*) diff --git a/tests/test_dfs.ml b/tests/test_dfs.ml new file mode 100644 index 00000000..23452087 --- /dev/null +++ b/tests/test_dfs.ml @@ -0,0 +1,73 @@ + +(* Stack-based DFS is tricky to get right. See + https://11011110.github.io/blog/2013/12/17/stack-based-graph-traversal.html + + On this graph, + + 0 + / \ + / \ + v v + 1---2---3 (All edges are undirected, + |\ /| apart from 0->1 0->3 1->5 and 3->6.) + | \ / | + | 4 | + | / \ | + v / \ v + 5 6 + + an incorrect stack-based DFS starting from 0 would first mark 1 and 3, + and then would not go as deep as possible in the traversal. + + In the following, we check that, whenever 2 and 4 are visited, + then necessarily both 1 and 3 are already visited. +*) + +open Format +open Graph +open Pack.Digraph + +let debug = false + +let g = create () +let v = Array.init 7 V.create +let () = Array.iter (add_vertex g) v +let adde x y = add_edge g v.(x) v.(y) +let addu x y = adde x y; adde y x +let () = adde 0 1; adde 0 3 +let () = addu 1 2; addu 2 3 +let () = adde 1 5; adde 3 6 +let () = addu 1 4; addu 4 3; addu 5 4; addu 4 6 + +let () = assert (Dfs.has_cycle g) + +let marked = Array.make 7 false +let reset () = Array.fill marked 0 7 false +let mark v = + let i = V.label v in + marked.(i) <- true; + if marked.(2) && marked.(4) then assert (marked.(1) && marked.(3)) + +let pre v = if debug then printf "pre %d@." (V.label v); mark v +let post v = if debug then printf "post %d@." (V.label v) +let f v () = if debug then printf "fold %d@." (V.label v); mark v + +let () = reset (); Dfs.iter ~pre ~post g +let () = reset (); Dfs.prefix pre g +let () = reset (); Dfs.postfix post g +let () = reset (); Dfs.iter_component ~pre ~post g v.(0) +let () = reset (); Dfs.prefix_component pre g v.(0) +let () = reset (); Dfs.postfix_component post g v.(0) +let () = reset (); Dfs.fold f () g +let () = reset (); Dfs.fold_component f () g v.(0) + +module D = Traverse.Dfs(Pack.Digraph) + +let rec visit it = + let v = D.get it in + mark v; + visit (D.step it) + +let () = try visit (D.start g) with Exit -> () + +let () = printf "All tests succeeded.@." diff --git a/tests/test_map_vertex.ml b/tests/test_map_vertex.ml index a4424941..ce225099 100644 --- a/tests/test_map_vertex.ml +++ b/tests/test_map_vertex.ml @@ -28,7 +28,10 @@ end module TestI(G: Sig.I with type V.label = int) = TestB(Builder.I(G)) module TestP(G: Sig.P with type V.label = int) = TestB(Builder.P(G)) -module Int = struct include Int let hash x = x let default = 42 end +module Int = struct + type t = int let compare = Stdlib.compare let equal = (=) + let hash x = x let default = 42 +end include TestI(Pack.Digraph) include TestI(Pack.Graph)