From a011e5fb7b313e8da69dbd8573901fbc3f9785cd Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Fri, 30 Jun 2023 10:44:41 +0200 Subject: [PATCH 1/8] Cycles: avoid use of Seq --- src/cycles.ml | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/cycles.ml b/src/cycles.ml index ea89305a..8b3c52db 100644 --- a/src/cycles.ml +++ b/src/cycles.ml @@ -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. *) From e25f5b7bc710087f0543f0239630d2dc32fe0ddc Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Fri, 30 Jun 2023 11:30:06 +0200 Subject: [PATCH 2/8] fixed Dfs.fold and Dfs.fold_component these were embarassingly not depth-first traversal see https://11011110.github.io/blog/2013/12/17/stack-based-graph-traversal.html for an explanation --- CHANGES.md | 3 ++ src/traverse.ml | 37 ++++++++++++------------ tests/dune | 5 ++++ tests/test_dfs.ml | 73 +++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 100 insertions(+), 18 deletions(-) create mode 100644 tests/test_dfs.ml diff --git a/CHANGES.md b/CHANGES.md index 8e837f34..ae597e58 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,7 @@ + + - :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/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 840bf7b2..ba9e0732 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_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.@." From 006736644a59c8d970a35210ff517e36e2d3b3b8 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Wed, 30 Aug 2023 09:40:28 +0200 Subject: [PATCH 3/8] prep new release --- CHANGES.md | 1 + ocamlgraph.opam | 2 +- ocamlgraph_gtk.opam | 2 +- 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ae597e58..9c7520c1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,5 @@ +# 2.1.0 (August 30, 2023) - :exclamation: [Traverse]: fixed [Dfs.fold] and [Dfs.fold_component], which were not implementing a proper DFS diff --git a/ocamlgraph.opam b/ocamlgraph.opam index 360f530d..8fa4599b 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: [ diff --git a/ocamlgraph_gtk.opam b/ocamlgraph_gtk.opam index 07998e5e..9950ea99 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: [ From ba8a7fae5aeb53307f8c06d99a1028be62e7cab0 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Wed, 30 Aug 2023 10:00:05 +0200 Subject: [PATCH 4/8] fixed compatibility with old and new versions of OCaml --- src/cycles.ml | 2 +- tests/dune | 32 ++++++++++++++++---------------- tests/test_components.ml | 3 +++ tests/test_map_vertex.ml | 5 ++++- 4 files changed, 24 insertions(+), 18 deletions(-) diff --git a/src/cycles.ml b/src/cycles.ml index 8b3c52db..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) diff --git a/tests/dune b/tests/dune index ba9e0732..28fe605a 100644 --- a/tests/dune +++ b/tests/dune @@ -220,22 +220,22 @@ ;; Rules for the test_components test -(rule - (with-stdout-to - test_components.output - (run ./test_components.exe))) - -(rule - (alias runtest) - (action - (progn - (diff test_components.expected test_components.output) - (echo "test_components: all tests succeeded.\n")))) - -(executable - (name test_components) - (modules test_components) - (libraries graph)) +;; (rule +;; (with-stdout-to +;; test_components.output +;; (run ./test_components.exe))) + +;; (rule +;; (alias runtest) +;; (action +;; (progn +;; (diff test_components.expected test_components.output) +;; (echo "test_components: all tests succeeded.\n")))) + +;; (executable +;; (name test_components) +;; (modules test_components) +;; (libraries graph)) ;; rules for the dot test diff --git a/tests/test_components.ml b/tests/test_components.ml index f052a57e..a46b8b55 100644 --- a/tests/test_components.ml +++ b/tests/test_components.ml @@ -22,6 +22,9 @@ module C = Components.Undirected(Pack.Graph) open Pack.Graph +(* FIXME: do not use Random here, as OCaml 5.0 seems to generate a + different graph *) + let () = Random.init 42; let g = Rand.graph ~v:10 ~e:3 () in 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) From da6f95f47337ac0b790885c9c5ece4e1663a4a42 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Wed, 30 Aug 2023 10:32:42 +0200 Subject: [PATCH 5/8] now requires at least OCaml 4.08.0 --- ocamlgraph.opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocamlgraph.opam b/ocamlgraph.opam index 8fa4599b..40c131d8 100644 --- a/ocamlgraph.opam +++ b/ocamlgraph.opam @@ -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" "dune" {>= "2.0"} "graphics" {with-test} From 9ebfbb119b50d98b31f34be4983cd4f842460ea0 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Wed, 30 Aug 2023 10:35:17 +0200 Subject: [PATCH 6/8] now requires at least OCaml 4.08.0 --- CHANGES.md | 1 + ocamlgraph_gtk.opam | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 9c7520c1..ea216312 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,7 @@ # 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] diff --git a/ocamlgraph_gtk.opam b/ocamlgraph_gtk.opam index 9950ea99..87067c22 100644 --- a/ocamlgraph_gtk.opam +++ b/ocamlgraph_gtk.opam @@ -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" From d37c5bfd6c7e5bdc0d1e647fee270f33e05e1880 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Thu, 31 Aug 2023 14:44:41 +0200 Subject: [PATCH 7/8] dune subst: dev, not pinned --- ocamlgraph.opam | 2 +- ocamlgraph_gtk.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ocamlgraph.opam b/ocamlgraph.opam index 40c131d8..9f1cf44b 100644 --- a/ocamlgraph.opam +++ b/ocamlgraph.opam @@ -24,7 +24,7 @@ depends: [ "graphics" {with-test} ] build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} [ "dune" "build" diff --git a/ocamlgraph_gtk.opam b/ocamlgraph_gtk.opam index 87067c22..6c8e8206 100644 --- a/ocamlgraph_gtk.opam +++ b/ocamlgraph_gtk.opam @@ -27,7 +27,7 @@ depends: [ "graphics" {with-test} ] build: [ - ["dune" "subst"] {pinned} + ["dune" "subst"] {dev} [ "dune" "build" From 4ad137fcd5ad0e04746179165fb31685a2e14790 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Filliatre Date: Thu, 31 Aug 2023 15:16:21 +0200 Subject: [PATCH 8/8] test_component not using Random anymore --- tests/dune | 32 ++++++++++++++++---------------- tests/test_components.expected | 16 +++++++--------- tests/test_components.ml | 21 +++++++++++---------- 3 files changed, 34 insertions(+), 35 deletions(-) diff --git a/tests/dune b/tests/dune index 28fe605a..ba9e0732 100644 --- a/tests/dune +++ b/tests/dune @@ -220,22 +220,22 @@ ;; Rules for the test_components test -;; (rule -;; (with-stdout-to -;; test_components.output -;; (run ./test_components.exe))) - -;; (rule -;; (alias runtest) -;; (action -;; (progn -;; (diff test_components.expected test_components.output) -;; (echo "test_components: all tests succeeded.\n")))) - -;; (executable -;; (name test_components) -;; (modules test_components) -;; (libraries graph)) +(rule + (with-stdout-to + test_components.output + (run ./test_components.exe))) + +(rule + (alias runtest) + (action + (progn + (diff test_components.expected test_components.output) + (echo "test_components: all tests succeeded.\n")))) + +(executable + (name test_components) + (modules test_components) + (libraries graph)) ;; rules for the dot test 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 a46b8b55..2141d6b5 100644 --- a/tests/test_components.ml +++ b/tests/test_components.ml @@ -22,19 +22,20 @@ module C = Components.Undirected(Pack.Graph) open Pack.Graph -(* FIXME: do not use Random here, as OCaml 5.0 seems to generate a - different 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: -*)