Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ocaml-ocamlgraph for openSUSE:Factory checked in at 2023-09-15 22:05:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-ocamlgraph (Old) and /work/SRC/openSUSE:Factory/.ocaml-ocamlgraph.new.1766 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-ocamlgraph" Fri Sep 15 22:05:28 2023 rev:5 rq:1111499 version:2.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-ocamlgraph/ocaml-ocamlgraph.changes 2021-04-29 01:37:16.866483249 +0200 +++ /work/SRC/openSUSE:Factory/.ocaml-ocamlgraph.new.1766/ocaml-ocamlgraph.changes 2023-09-15 22:10:51.952699801 +0200 @@ -1,0 +2,6 @@ +Sat Sep 9 09:09:09 UTC 2023 - oher...@suse.de + +- Update to version 2.1.0 + See included CHANGES.md for details + +------------------------------------------------------------------- Old: ---- ocaml-ocamlgraph-2.0.0.tar.xz New: ---- ocaml-ocamlgraph-2.1.0.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-ocamlgraph.spec ++++++ --- /var/tmp/diff_new_pack.xDNihy/_old 2023-09-15 22:10:53.716762874 +0200 +++ /var/tmp/diff_new_pack.xDNihy/_new 2023-09-15 22:10:53.720763017 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-ocamlgraph # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2023 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,18 +17,19 @@ Name: ocaml-ocamlgraph -Version: 2.0.0 +Version: 2.1.0 Release: 0 %{?ocaml_preserve_bytecode} Summary: Graph library for OCaml License: LGPL-2.1 Group: Development/Languages/OCaml URL: https://opam.ocaml.org/packages/ocamlgraph -Source: %{name}-%{version}.tar.xz -BuildRequires: ocaml +Source: %name-%version.tar.xz +BuildRequires: ocaml(ocaml_base_version) >= 4.08 BuildRequires: ocaml-dune >= 2.0 -BuildRequires: ocaml-rpm-macros >= 20210121 +BuildRequires: ocaml-rpm-macros >= 20230101 BuildRequires: ocamlfind(stdlib-shims) +BuildRequires: ocamlfind(graphics) %description OCamlgraph is a graph library for Objective Caml. @@ -36,12 +37,12 @@ %package devel Summary: Development files for the OcamlGraph graph library Group: Development/Languages/OCaml -Requires: %{name} = %{version} +Requires: %name = %version %description devel OCamlgraph is a graph library for Objective Caml. -This package contains development files for %{name}. +This package contains development files for %name. %prep %autosetup -p1 @@ -58,7 +59,7 @@ %check %ocaml_dune_test -%files -f %{name}.files +%files -f %name.files -%files devel -f %{name}.files.devel +%files devel -f %name.files.devel ++++++ _service ++++++ --- /var/tmp/diff_new_pack.xDNihy/_old 2023-09-15 22:10:53.748764018 +0200 +++ /var/tmp/diff_new_pack.xDNihy/_new 2023-09-15 22:10:53.752764161 +0200 @@ -1,7 +1,7 @@ <services> <service name="tar_scm" mode="disabled"> <param name="filename">ocaml-ocamlgraph</param> - <param name="revision">f97d342db06ccdbc11354303b5f225ae433f7ef3</param> + <param name="revision">9ebfbb119b50d98b31f34be4983cd4f842460ea0</param> <param name="scm">git</param> <param name="submodules">disable</param> <param name="url">https://github.com/backtracking/ocamlgraph.git</param> ++++++ ocaml-ocamlgraph-2.0.0.tar.xz -> ocaml-ocamlgraph-2.1.0.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/CHANGES.md new/ocaml-ocamlgraph-2.1.0/CHANGES.md --- old/ocaml-ocamlgraph-2.0.0/CHANGES.md 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/CHANGES.md 2023-08-30 10:35:17.000000000 +0200 @@ -1,8 +1,23 @@ +# 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] + and [BiConnectivity]) (Timothy Bourke) + - [Dominator]: non-trivial dominators (Timothy Bourke) + - #31: fixed documentation of [map_vertex]: the supplied function + must be injective + - #110: ensure that map_vertex applies the function only once per vertex + # 2.0.0 (October 2, 2020) - port to dune and opam 2.0 - - :exclamation: opam package now split into two packages: ocamlgraph and ocamlgraph_gtk + - :exclamation: opam package now split into two packages: ocamlgraph + and ocamlgraph_gtk - [WeakTopological] fixed incorrect use of generic hash tables (#99, Tomáš DacÃk) - [Oper] fixed transitive_reduction (#91) @@ -12,7 +27,11 @@ - :exclamation: [Coloring] functions now fail if the graph is directed - :exclamation: [Coloring] now uses a single, global exception [NoColoring] - [Coloring] new function two_color to 2-color a graph (or fail) - - :exclamation: [Fixpoint] Take initial labeling of nodes into account (Johannes Kloos) + - :exclamation: [Fixpoint] Take initial labeling of nodes into + account (Johannes Kloos) + - :exclamation: [Dominator.Make_graph] now accepts a signature that + is Builder-compatible + # 1.8.8, October 17, 2017 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/README.md new/ocaml-ocamlgraph-2.1.0/README.md --- old/ocaml-ocamlgraph-2.0.0/README.md 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/README.md 2023-08-30 10:35:17.000000000 +0200 @@ -1,6 +1,6 @@ # OCamlgraph -OCamlgraph is a graph library for Ocaml. Its contribution is three-fold: +OCamlgraph is a graph library for OCaml. Its contribution is three-fold: 1. It provides an easy-to-use graph implementation together with several operations and algorithms over graphs, in Graph.Pack.Digraph. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/ocamlgraph.opam new/ocaml-ocamlgraph-2.1.0/ocamlgraph.opam --- old/ocaml-ocamlgraph-2.0.0/ocamlgraph.opam 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/ocamlgraph.opam 2023-08-30 10:35:17.000000000 +0200 @@ -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: ["filli...@lri.fr"] +maintainer: ["jean-christophe.fillia...@cnrs.fr"] authors: ["Sylvain Conchon" "Jean-Christophe Filliâtre" "Julien Signoles"] license: "LGPL-2.1-only" tags: [ @@ -15,11 +15,13 @@ "imperative" ] homepage: "https://github.com/backtracking/ocamlgraph/" +doc: "https://backtracking.github.io/ocamlgraph" bug-reports: "https://github.com/backtracking/ocamlgraph/issues/new" depends: [ - "ocaml" + "ocaml" {>= "4.08.0"} "stdlib-shims" "dune" {>= "2.0"} + "graphics" {with-test} ] build: [ ["dune" "subst"] {pinned} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/ocamlgraph_gtk.opam new/ocaml-ocamlgraph-2.1.0/ocamlgraph_gtk.opam --- old/ocaml-ocamlgraph-2.0.0/ocamlgraph_gtk.opam 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/ocamlgraph_gtk.opam 2023-08-30 10:35:17.000000000 +0200 @@ -1,7 +1,7 @@ opam-version: "2.0" synopsis: "Displaying graphs using OCamlGraph and GTK" description: "Displaying graphs using OCamlGraph and GTK" -maintainer: ["filli...@lri.fr"] +maintainer: ["jean-christophe.fillia...@cnrs.fr"] authors: ["Sylvain Conchon" "Jean-Christophe Filliâtre" "Julien Signoles"] license: "LGPL-2.1-only" tags: [ @@ -15,14 +15,16 @@ "imperative" ] homepage: "https://github.com/backtracking/ocamlgraph/" +doc: "https://backtracking.github.io/ocamlgraph" bug-reports: "https://github.com/backtracking/ocamlgraph/issues/new" depends: [ - "ocaml" + "ocaml" {>= "4.08.0"} "stdlib-shims" "lablgtk" "conf-gnomecanvas" - "ocamlgraph" + "ocamlgraph" {>= "2.0.0"} "dune" {>= "2.0"} + "graphics" {with-test} ] build: [ ["dune" "subst"] {pinned} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/blocks.ml new/ocaml-ocamlgraph-2.1.0/src/blocks.ml --- old/ocaml-ocamlgraph-2.0.0/src/blocks.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/blocks.ml 2023-08-30 10:35:17.000000000 +0200 @@ -235,8 +235,10 @@ let succ g v = S.elements (HM.find_and_raise v g "[ocamlgraph] succ") let succ_e g v = fold_succ_e (fun e l -> e :: l) g v [] - let map_vertex f = - HM.map (fun v s -> f v, S.fold (fun v s -> S.add (f v) s) s S.empty) + let map_vertex f g = + let module MV = Util.Memo(V) in + let f = MV.memo f in + HM.map (fun v s -> f v, S.fold (fun v s -> S.add (f v) s) s S.empty) g module I = struct type t = S.t HM.t @@ -348,9 +350,11 @@ let succ g v = fold_succ (fun w l -> w :: l) g v [] let succ_e g v = fold_succ_e (fun e l -> e :: l) g v [] - let map_vertex f = + let map_vertex f g = + let module MV = Util.Memo(V) in + let f = MV.memo f in HM.map - (fun v s -> f v, S.fold (fun (v, l) s -> S.add (f v, l) s) s S.empty) + (fun v s -> f v, S.fold (fun (v, l) s -> S.add (f v, l) s) s S.empty) g module I = struct type t = S.t HM.t @@ -561,12 +565,15 @@ let succ g v = S.elements (snd (HM.find_and_raise v g "[ocamlgraph] succ")) let succ_e g v = fold_succ_e (fun e l -> e :: l) g v [] - let map_vertex f = + let map_vertex f g = + let module MV = Util.Memo(V) in + let f = MV.memo f in HM.map (fun v (s1,s2) -> f v, (S.fold (fun v s -> S.add (f v) s) s1 S.empty, S.fold (fun v s -> S.add (f v) s) s2 S.empty)) + g module I = struct (* we keep sets for both incoming and outgoing edges *) @@ -703,12 +710,15 @@ let succ g v = fold_succ (fun w l -> w :: l) g v [] let succ_e g v = fold_succ_e (fun e l -> e :: l) g v [] - let map_vertex f = + let map_vertex f g = + let module MV = Util.Memo(V) in + let f = MV.memo f in HM.map (fun v (s1,s2) -> f v, (S.fold (fun (v, l) s -> S.add (f v, l) s) s1 S.empty, S.fold (fun (v, l) s -> S.add (f v, l) s) s2 S.empty)) + g module I = struct type t = (S.t * S.t) HM.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/classic.ml new/ocaml-ocamlgraph-2.1.0/src/classic.ml --- old/ocaml-ocamlgraph-2.0.0/src/classic.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/classic.ml 2023-08-30 10:35:17.000000000 +0200 @@ -19,16 +19,21 @@ module type S = sig type graph + type vertex val divisors : int -> graph val de_bruijn : int -> graph val vertex_only : int -> graph val full : ?self:bool -> int -> graph + val cycle : int -> graph * vertex array + val grid : n:int -> m:int -> graph * vertex array array end module Generic(B : Builder.INT) = struct type graph = B.G.t + type vertex = B.G.V.t + let divisors n = if n < 2 then invalid_arg "divisors"; let v = Array.init (n + 1) (fun i -> B.G.V.create i) in @@ -78,6 +83,28 @@ g) (fold_for 1 n (fun g i -> B.add_vertex g v.(i)) (B.empty ())) + let cycle n = + if n < 0 then invalid_arg "cycle"; + let v = Array.init n (fun i -> B.G.V.create i) in + let g = Array.fold_left B.add_vertex (B.empty ()) v in + let rec loop g i = + if i = n then g + else let g = B.add_edge g v.(i) v.((i+1) mod n) in loop g (i+1) in + loop g 0, v + + let grid ~n ~m = + if n < 0 || m < 0 then invalid_arg "grid"; + let create i j = B.G.V.create (m * i + j) in + let v = Array.init n (fun i -> Array.init m (fun j -> create i j)) in + let g = Array.fold_left (Array.fold_left B.add_vertex) (B.empty ()) v in + let rec loop g i j = + if i = n then g + else if j = m then loop g (i+1) 0 + else let g = if j < m-1 then B.add_edge g v.(i).(j) v.(i).(j+1) else g in + let g = if i < n-1 then B.add_edge g v.(i).(j) v.(i+1).(j) else g in + loop g i (j+1) in + loop g 0 0, v + end module P (G : Sig.P with type V.label = int) = Generic(Builder.P(G)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/classic.mli new/ocaml-ocamlgraph-2.1.0/src/classic.mli --- old/ocaml-ocamlgraph-2.0.0/src/classic.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/classic.mli 2023-08-30 10:35:17.000000000 +0200 @@ -15,14 +15,14 @@ (* *) (**************************************************************************) -(* $Id: classic.mli,v 1.12 2005-02-25 13:54:33 signoles Exp $ *) - (** Some classic graphs *) module type S = sig type graph + type vertex + val divisors : int -> graph (** [divisors n] builds the graph of divisors. Vertices are integers from [2] to [n]. [i] is connected to [j] if @@ -45,10 +45,24 @@ The optional argument [self] indicates if loop edges should be added (default value is [true]). *) + val cycle : int -> graph * vertex array + (** [cycle n] builds a graph that is a cycle with [n] vertices. + Vertices are labelled with [0,1,...,n-1] and there is an edge from + vertex [i] to vertex [(i+1) mod n]. + Vertices are also returned in an array for convenience. *) + + val grid : n:int -> m:int -> graph * vertex array array + (** [grid n m] builds a grid graph with [n*m] vertices, with edges + from vertex [(i,j)] to vertices [(i+1,j)] and [(i,j+1)] (and no + wrapping around). Vertex [(i,j)] is labelled with [i*m+j]. + Vertices are also returned in a [n*m] matrix for convenience. *) + end -module P (G : Sig.P with type V.label = int) : S with type graph = G.t +module P (G : Sig.P with type V.label = int) : + S with type graph = G.t and type vertex = G.V.t (** Classic Persistent Graphs *) -module I (G : Sig.I with type V.label = int) : S with type graph = G.t +module I (G : Sig.I with type V.label = int) : + S with type graph = G.t and type vertex = G.V.t (** Classic Imperative Graphs *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/components.ml new/ocaml-ocamlgraph-2.1.0/src/components.ml --- old/ocaml-ocamlgraph-2.0.0/src/components.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/components.ml 2023-08-30 10:35:17.000000000 +0200 @@ -96,6 +96,78 @@ end +(** Connectivity in strongly connected directed graphs *) + +module Connectivity (GB: Builder.S) = struct + + module MOper = Oper.Make(GB) + module Choose = Oper.Choose(GB.G) + module Dom = Dominator.Make(GB.G) + + module S = Dom.S + + let sstrong_articulation_points g = + let s = Choose.choose_vertex g in + let module SCC = Make (struct + include GB.G + let iter_vertex f = + GB.G.iter_vertex (fun v -> if not (V.equal s v) then f v) + let iter_succ f = + GB.G.iter_succ (fun v -> if not (V.equal s v) then f v) + end) + in + let s_is_sap = fst (SCC.scc g) > 1 in + let dt_s = Dom.(idom_to_dom_tree g (compute_idom g s)) in + let d_s = Dom.dom_tree_to_snontrivial_dom s dt_s in + let g_r = MOper.mirror g in + let dtr_s = Dom.(idom_to_dom_tree g_r (compute_idom g_r s)) in + let dr_s = Dom.dom_tree_to_snontrivial_dom s dtr_s in + let d = Dom.S.union d_s dr_s in + if s_is_sap then Dom.S.add s d else d + + let strong_articulation_points g = S.elements (sstrong_articulation_points g) + +end + +module BiConnectivity (G: Sig.G) = struct + + module Choose = Oper.Choose(G) + module Dom = Dominator.Make(G) + module RDom = Dominator.Make( + struct + type t = G.t + module V = G.V + let pred = G.succ + let succ = G.pred + let fold_vertex = G.fold_vertex + let iter_vertex = G.iter_vertex + let iter_succ = G.iter_pred + let nb_vertex = G.nb_vertex + end) + + module S = Dom.S + + let sstrong_articulation_points g = + let s = Choose.choose_vertex g in + let module SCC = Make (struct + include G + let iter_vertex f = + G.iter_vertex (fun v -> if not (V.equal s v) then f v) + let iter_succ f = + G.iter_succ (fun v -> if not (V.equal s v) then f v) + end) + in + let s_is_sap = fst (SCC.scc g) > 1 in + let dt_s = Dom.(idom_to_dom_tree g (compute_idom g s)) in + let d_s = Dom.dom_tree_to_snontrivial_dom s dt_s in + let dtr_s = RDom.(idom_to_dom_tree g (compute_idom g s)) in + let dr_s = Dom.dom_tree_to_snontrivial_dom s dtr_s in + let d = Dom.S.union d_s dr_s in + if s_is_sap then Dom.S.add s d else d + + let strong_articulation_points g = S.elements (sstrong_articulation_points g) +end + (** Connected components (for undirected graphs) *) module type U = sig diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/components.mli new/ocaml-ocamlgraph-2.1.0/src/components.mli --- old/ocaml-ocamlgraph-2.0.0/src/components.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/components.mli 2023-08-30 10:35:17.000000000 +0200 @@ -38,7 +38,7 @@ number. In particular, [f u = f v] if and only if [u] and [v] are in the same component. Another property of the numbering is that components are numbered in a topological - order: if there is an arc from [u] to [v], then [f u >= f u] + order: if there is an arc from [u] to [v], then [f u >= f v] Not tail-recursive. Complexity: O(V+E) @@ -56,6 +56,55 @@ end +(** Connectivity in strongly connected directed graphs *) + +module Connectivity (GB: Builder.S) : sig + module S : Set.S with type elt = GB.G.vertex + + val strong_articulation_points : GB.G.t -> GB.G.vertex list + (** Computes the strong articulation points of the given + strongly connected directed graph. The result is undefined if the + input graph is not directed and strongly connected. + + A strong articulation point is a vertex that when removed from the + original graph disconnects that graph into two or more components. + + The implementation involves constructing the mirror image of the + graph; for bidirectional graphs prefer {!module:BiConnectivity}. + + Implements the algorithm from Italiano, Laura, and Santaroni, + TCS 447 (2012), "Finding strong bridges and strong articulation points + in linear time". + Complexity: O(V + E) *) + + val sstrong_articulation_points : GB.G.t -> S.t + (** As for [strong_articulation_points] but returns a set. *) +end + +module BiConnectivity (G: Sig.G) : sig + + module S : Set.S with type elt = G.vertex + + val strong_articulation_points : G.t -> G.vertex list + (** Computes the strong articulation points of the given + strongly connected directed graph. The result is undefined if the + input graph is not directed and strongly connected. + + A strong articulation point is a vertex that when removed from the + original graph disconnects that graph into two or more components. + + The implementation traverses the graph by iterating over predecessors; + for unidirectional graphs prefer {!module:Connectivity}. + + Implements the algorithm from Italiano, Laura, and Santaroni, + TCS 447 (2012), "Finding strong bridges and strong articulation points + in linear time". + Complexity: O(V + E) *) + + val sstrong_articulation_points : G.t -> S.t + (** As for [strong_articulation_points] but returns a set. *) +end + (** Connected components (for undirected graphs). The implementation uses union-find. Time complexity is (quasi) O(V+E). Space complexity is O(V). *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/cycles.ml new/ocaml-ocamlgraph-2.1.0/src/cycles.ml --- old/ocaml-ocamlgraph-2.0.0/src/cycles.ml 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-ocamlgraph-2.1.0/src/cycles.ml 2023-08-30 10:35:17.000000000 +0200 @@ -0,0 +1,332 @@ + +type weight = + | Normal of int + | Obligatory of int + +module Fashwo + (GB : sig + include Builder.S + val weight : G.edge -> weight + end) += +struct + module G = GB.G + + exception Stuck of G.vertex list + + 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) + + (* The algorithm of Eades, Lin, and Smyth (ELS 1993) works by "scheduling" + vertexes onto two lists called s1 and s2. At each iteration a vertex is + chosen, scheduled, and removed from the graph. Arcs from a newly scheduled + node toward nodes already in s1 are classified as "leftward"; they are + included in the generated feedback arc set. "Rightward" arcs, to vertexes + in s2 or that have not yet been scheduled, are not included in the + feedback arc set. The algorithm tries to maximize the number of rightward + arcs and thereby minimize the number of leftward ones. Source vertexes, + those with no incoming arcs in the current graph (i.e., because all its + predecssors have already been scheduled), are appended directly onto s1 + and do not induce any feedback arcs. Sink vertexes are consed directly + onto s2 and do not induce any feedback arcs. Otherwise, the algorithm + chooses a vertex to maximize the difference between the number of + outgoing arcs and the number of incoming ones: the (remaining) incoming + arcs must be included in the feedback arc set. The difference between the + number of rightward arcs (no cost) and the number of leftward arcs + (feedback arcs) is called "delta". The algorithm is implemented + efficiently by using a data structure to group unscheduled vertexes + according to their delta value. When more than one vertex has the maximum + delta value, the original algorithm makes an arbitrary choice. The + algorithm of Eades and Lin (EL 1995) makes the choice using a heuristic + that maximizes the difference between incoming arcs and outgoing ones in + the vertexes that remain at the end of the iteration as such vertexes are + the most "unbalanced" and thus less likely to contribute to the feedback + arc set in future iterations. The EL 1995 algorithm includes a further + refinement to ignore chains of vertexes when looking for unbalanced ones, + since such chains do not contribute feedback arcs. + + Since we just want to produce a list of feedback arcs, we don't bother + tracking order in s1, and we only track s2 to properly handle the + preprocessing optimization that removes two cycles. We maintain lists of + source and sink vertexes (scheduled but not yet removed from the graph) + and a map from delta values to sets of vertexes. As the delta value map + caches the state of the graph, it must be updated when the a vertex is + scheduled and removed from the graph. Additionally, we remember which two + cycles were removed during preprocessing and ensure that one of their + arcs is included in the feedback arc set, depending on whichever of the + two interlinked vertexes is scheduled first. *) + + type t = { + s1 : VS.t; (* vertexes placed "at left" *) + s2 : VS.t; (* vertexes placed "at right"; + only needed to optimize for two_cycles *) + sources : VS.t; (* vertexes with no incoming arcs *) + sinks : VS.t; (* vertexes with no outgoing arcs *) + delta_bins : VS.t IM.t; (* group vertexes by delta value *) + vertex_bin : int VM.t; (* map each vertex to its bin *) + two_cycles : G.edge list VM.t; (* edges for 2-cycles *) + fas : G.edge list; (* current feedback arc set *) + } + + let empty = { + s1 = VS.empty; + s2 = VS.empty; + sources = VS.empty; + sinks = VS.empty; + delta_bins = IM.empty; + vertex_bin = VM.empty; + two_cycles = VM.empty; + fas = []; + } + + let add_to_bin delta v ({ delta_bins; vertex_bin; _ } as st) = + { st with delta_bins = + IM.update delta (function None -> Some (VS.singleton v) + | Some vs -> Some (VS.add v vs)) + delta_bins; + vertex_bin = VM.add v delta vertex_bin } + + let remove_from_bin v ({ delta_bins; vertex_bin; _ } as st) = + match VM.find_opt v vertex_bin with + | None -> st + | Some delta -> + { st with delta_bins = + IM.update delta (function None -> None + | Some vs -> Some (VS.remove v vs)) + delta_bins; + vertex_bin = VM.remove v vertex_bin } + + (* Calculate the sums of incoming and outgoing edge weights, ignoring + obligatory arcs; they must be respected so their weight is irrelevant. *) + let weights g v = + let add_pweight e (s, b) = + match GB.weight e with Obligatory _ -> (s, true) | Normal w -> (s + w, b) + in + let add_sweight e s = + match GB.weight e with Obligatory w -> s + w | Normal w -> s + w + in + let inw, blocked = G.fold_pred_e add_pweight g v (0, false) in + let outw = G.fold_succ_e add_sweight g v 0 in + blocked, inw, outw + + let add_vertex g v delta ({ sources; sinks; _ } as st) = + let ind, outd = G.in_degree g v, G.out_degree g v in + if ind = 0 then { st with sources = VS.add v sources } + else if outd = 0 then { st with sinks = VS.add v sinks } + else add_to_bin delta v st + + (* Initialize the state for a given vertex. *) + let init_vertex g v st = + let blocked, inw, outw = weights g v in + if blocked then st else add_vertex g v (outw - inw) st + + let init g = G.fold_vertex (init_vertex g) g empty + + (* Move v from the bin for delta to sources, sinks, or another bin. *) + let shift_bins g v delta' st0 = add_vertex g v delta' (remove_from_bin v st0) + + (* Before removing v from the graph, update the state of its sucessors. *) + let update_removed_succ g' e st = + let v = G.E.dst e in + let still_blocked, inw', outw' = weights g' v in + if still_blocked then st else shift_bins g' v (outw' - inw') st + + (* Before removing v from the graph, update the state of its predecessors. *) + let update_removed_pred g' e ({ sinks; _ } as st) = + let v = G.E.src e in + let blocked, inw', outw' = weights g' v in + match GB.weight e with + | Obligatory _ -> + if blocked || outw' > 0 then st + else (* not blocked && outw' = 0 *) + { (remove_from_bin v st) with sinks = VS.add v sinks } + | Normal _ -> + if blocked then st else shift_bins g' v (outw' - inw') st + + (* Remove a vertex from the graph and update the data structures for its + succesors and predecessors. *) + let remove_vertex g v st = + let g' = GB.remove_vertex g v in + (g', G.fold_succ_e (update_removed_succ g') g v st + |> G.fold_pred_e (update_removed_pred g') g v) + + (* The original article proposes preprocessing the graph to condense long + chains of vertexes. This works together with the heuristic for generating + unbalanced vertexes, since the intermediate nodes on the chain do not + contribute any leftward arcs (when the last vertex is removed, they + become a sequence of sinks). Using such a preprocessing step with + weighted edges risks removing good feedback arcs, i.e., those with a big + difference between outgoing and incoming weights. That is why here we + use on-the-fly condensation, even if there is a risk of recomputing the + same result several times. *) + let rec condense w g v = + if G.out_degree g v = 1 then + match G.pred g v with + | [u] when not (G.V.equal u w) -> condense w g u + | _ -> v + else v + + (* Find the vertex v that has the most "unbalanced" predecessor u. Most + unbalanced means the biggest difference between the input weights and + output weights. Skip any vertex with an incoming obligatory arc. *) + let takemax g v imax = + let check_edge e max = (* check u -> v *) + let u_blocked, u_inw, u_outw = + weights g (condense (G.E.dst e) g (G.E.src e)) in + let u_w = u_inw - u_outw in + match max with + | Some (None, _) + | None -> Some ((if u_blocked then None else Some u_w), v) + | Some (Some x_w, _) when u_w > x_w -> Some (Some u_w, v) + | _ -> max + in + G.fold_pred_e check_edge g v imax + + (* Look for the vertex with the highest delta value that is not the target + 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 + | Seq.Cons ((_, dbin), tl) -> + (match VS.fold (takemax g) dbin None with + | None -> f (tl ()) + | 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. *) + let add_from_two_cycles s1 s2 two_cycles v fas = + let bf es b = if G.V.equal (G.E.dst b) v then b::es else es in + let f es e = + let w = G.E.dst e in + if VS.mem w s1 then e::es + else if VS.mem w s2 then + (* the two-cycle partner has already been scheduled as sink, so + the feedback edges come from it. *) + match VM.find_opt w two_cycles with + | None -> es + | Some bs -> List.fold_left bf es bs + else es in + match VM.find_opt v two_cycles with + | None -> fas + | Some es -> List.fold_left f fas es + + (* Shift a given vertex onto s1, and add any leftward arcs to the feedback + arc set. *) + let schedule_vertex g (v, ({ s1; s2; fas; two_cycles; _ } as st)) = + let add_to_fas e es = if VS.mem (G.E.src e) s1 then es else e::es in + (v, { st with s1 = VS.add v s1; + fas = G.fold_pred_e add_to_fas g v fas + |> add_from_two_cycles s1 s2 two_cycles v }) + + (* Take the next available vertex from, in order, sources, sinks, or the + highset possible delta bin. *) + let choose_vertex g ({ s1; s2; sources; sinks; two_cycles; fas; _ } as st0) = + match VS.choose_opt sources with + | Some v -> + Some (v, { st0 with sources = VS.remove v sources; + sinks = VS.remove v sinks; + s1 = VS.add v s1; + fas = add_from_two_cycles s1 s2 two_cycles v fas }) + | None -> + (match VS.choose_opt sinks with + | Some v -> + Some (v, { st0 with sinks = VS.remove v sinks; + s2 = VS.add v s2; + fas = add_from_two_cycles s1 s2 two_cycles v fas }) + | None -> Option.map (schedule_vertex g) (max_from_deltas g st0)) + + let add_two_cycle_edge two_cycles e = + VM.update (G.E.src e) (function None -> Some [e] + | Some es -> Some (e :: es)) two_cycles + + let same_weight w e = + match GB.weight e with + | Obligatory _ -> false + | Normal w' -> w' = w + + (* For every pair of distinct vertexes A and B linked to each other by + edges A -ab-> B and B -ba-> A with the same weight, update the mapping + by linking A to ab, and B to ba, and remove the edges from the graph. + When A is scheduled, if B is already in s1 then the edge ab is a + feedback arc, and similarly for B and ba. The principle is that there + will be a feedback arc regardless of whether A is "scheduled" before B or + vice versa, therefore such cycles should not constrain vertex choices. *) + let remove_two_cycles g0 = + let f e ((g, cycles) as unchanged) = + match GB.weight e with + | Obligatory _ -> unchanged + | Normal w -> + if List.length (G.find_all_edges g0 (G.E.src e) (G.E.dst e)) > 1 + (* invalid for graphs like: { A -1-> B, A -2-> B, B -3-> A *) + then raise Exit + else + let back_edges = + G.find_all_edges g0 (G.E.dst e) (G.E.src e) + |> List.filter (same_weight w) + in + if back_edges = [] then unchanged + else (GB.remove_edge_e g e, + List.fold_left add_two_cycle_edge cycles back_edges) + in + try + G.fold_edges_e f g0 (g0, VM.empty) + with Exit -> (g0, VM.empty) + + (* All self loops must be broken, so just add them straight into the + feedback arc set. *) + let remove_self_loops g0 = + let f v (g, fas) = + let self_loops = G.find_all_edges g0 v v in + (List.fold_left GB.remove_edge_e g self_loops, + List.rev_append self_loops fas) + in + G.fold_vertex f g0 (g0, []) + + (* Remove any arcs between strongly connected components. There can be no + cycles between distinct sccs by definition. *) + module C = Components.Make(G) + module Emap = Gmap.Edge(G)(struct include GB.G include GB end) + + let disconnect_sccs g = + let nsccs, fscc = C.scc g in + let in_same_scc e = + if fscc (G.E.src e) = fscc (G.E.dst e) then Some e else None + in + if nsccs < 2 then g + else Emap.filter_map in_same_scc g + + let feedback_arc_set g0 = + let rec loop (g, st) = + match choose_vertex g st with + | Some (v, st') when G.mem_vertex g v -> loop (remove_vertex g v st') + | Some (_, st') -> loop (g, st') + | None -> + let remaining = IM.fold (Fun.const VS.union) st.delta_bins VS.empty in + if VS.is_empty remaining then st.fas + else raise (Stuck (VS.elements remaining)) + in + let g1 = disconnect_sccs g0 in + let g2, fas = remove_self_loops g1 in + let g3, two_cycles = remove_two_cycles g2 in + loop (g3, { (init g3) with fas; two_cycles }) + +end + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/cycles.mli new/ocaml-ocamlgraph-2.1.0/src/cycles.mli --- old/ocaml-ocamlgraph-2.0.0/src/cycles.mli 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-ocamlgraph-2.1.0/src/cycles.mli 2023-08-30 10:35:17.000000000 +0200 @@ -0,0 +1,71 @@ +(**************************************************************************) +(* *) +(* Ocamlgraph: a generic graph library for OCaml *) +(* Copyright (C) 2004-2022 *) +(* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles *) +(* *) +(* This software is free software; you can redistribute it and/or *) +(* modify it under the terms of the GNU Library General Public *) +(* License version 2.1, with the special exception on linking *) +(* described in file LICENSE. *) +(* *) +(* This software is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) +(* *) +(**************************************************************************) + +(** Algorithms related to cycles in directed graphs. *) + +type weight = + | Normal of int + (** Weighted arc that can be included in the feedback set. The + weight must be zero (not normally a good choice) or positive + (1 may be a good choice). *) + | Obligatory of int + (** Obligatory arc that cannot be returned in the feedback set. + Set the weight to zero to completely ignore obligatory arcs + when choosing which vertex to schedule. Set it to a positive + value (1 may be a good choice) to adjust the preference for + choosing vertexes that may "unblock" other vertexes by + removing their incoming obligatory arcs. *) + +(** Adaptation of the FASH algorithm of Eades and Lin (1995) to handle + edge weights and obligatory arcs. The algorithm tries to minimize the + total weight of the returned feedback arc set. Obligatory arcs are + respected and never returned in the feedback arc set, an exception is + raised if the obligatory arcs form a cycle. The adapted algorithm is + hereby called FASHWO: âfeedback arc set heuristic + weights and + obligationsâ. + + For a graph G and any one of its feedback arc sets F, the graph G - F is + obviously acyclic. If F is minimal, i.e., adding any of its edges to G - F + would introduce a cycle, then reversing, rather than removing, the + feedback arcs also gives an ayclic graph, [G - F + F^R]. In fact, Eades + and Lin define the feedback arc set as "a set of arcs whose reversal makes + G acyclic". + + @see <https://mathoverflow.net/a/234023/> David Epstein proof about reversed arcs *) +module Fashwo + (GB : sig + include Builder.S + + (** Assign weights to edges. *) + val weight : G.edge -> weight + end) : +sig + (** Raised if cycles remain and all the remaining vertexes are obligatory. + The argument gives the list of remaining vertexes. *) + exception Stuck of GB.G.vertex list + + (** Return a minimal set of arcs whose removal or reversal would make the + given graph acyclic. + + By minimal, we mean that each arc in the returned list must be removed + or reversed, i.e., none are superfluous. Since a heuristic is used, the + returned list may not be a minimum feedback arc set. Finding the {i + minimum feedback arc set}, dually, the {i maximum acyclic subgraph} is + NP-hard for general graphs. *) + val feedback_arc_set : GB.G.t -> GB.G.edge list +end + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/dominator.ml new/ocaml-ocamlgraph-2.1.0/src/dominator.ml --- old/ocaml-ocamlgraph-2.0.0/src/dominator.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/dominator.ml 2023-08-30 10:35:17.000000000 +0200 @@ -71,6 +71,8 @@ val compute_dom_frontier: t -> dom_tree -> idom -> vertex -> vertex list val idom_to_dominators: ('a -> 'a) -> 'a -> 'a list val idom_to_dom: (vertex -> vertex) -> vertex -> vertex -> bool + val dom_tree_to_nontrivial_dom : vertex -> dom_tree -> vertex list + val dom_tree_to_snontrivial_dom : vertex -> dom_tree -> S.t end module Make(G : G) = struct @@ -349,6 +351,30 @@ with Not_found -> false + (* There is a nice description of non-trivial dominators with an example + in Section 2 and Figure 2 of Jaberi 2016, "On computing the + 2-vertex-connected components of directed graphs". *) + + let dom_tree_to_nontrivial_dom v dt = + let rec f rs = function + | [] -> rs + | x::xs -> + (match dt x with + | [] -> f rs xs + | ys -> f (x::rs) (List.rev_append ys xs)) + in + f [] (dt v) + + let dom_tree_to_snontrivial_dom v dt = + let rec f rs = function + | [] -> rs + | x::xs -> + (match dt x with + | [] -> f rs xs + | ys -> f (S.add x rs) (List.rev_append ys xs)) + in + f S.empty (dt v) + end module Make_graph(G: I) = struct diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/dominator.mli new/ocaml-ocamlgraph-2.1.0/src/dominator.mli --- old/ocaml-ocamlgraph-2.0.0/src/dominator.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/dominator.mli 2023-08-30 10:35:17.000000000 +0200 @@ -122,6 +122,16 @@ val idom_to_dom: (vertex -> vertex) -> vertex -> vertex -> bool + (** Returns a list of the non-trivial dominators of a flowgraph G(v) given + the start vertex [v] and the corresponding dominator tree. E.g., + [dom_tree_to_nontrivial_dom v (idom_to_dom_tree g (compute_idom g v))]. + A vertex u is a non-trivial dominator of G(v) if it dominates some + vertex w other than v and u. *) + val dom_tree_to_nontrivial_dom : vertex -> dom_tree -> vertex list + + (** As for [dom_tree_to_nontrivial_dom] but returns a set. *) + val dom_tree_to_snontrivial_dom : vertex -> dom_tree -> S.t + end module Make(G : G) : S with type t = G.t and type vertex = G.V.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/eulerian.ml new/ocaml-ocamlgraph-2.1.0/src/eulerian.ml --- old/ocaml-ocamlgraph-2.0.0/src/eulerian.ml 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-ocamlgraph-2.1.0/src/eulerian.ml 2023-08-30 10:35:17.000000000 +0200 @@ -0,0 +1,269 @@ +(**************************************************************************) +(* *) +(* Ocamlgraph: a generic graph library for OCaml *) +(* Copyright (C) 2004-2010 *) +(* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles *) +(* *) +(* This software is free software; you can redistribute it and/or *) +(* modify it under the terms of the GNU Library General Public *) +(* License version 2.1, with the special exception on linking *) +(* described in file LICENSE. *) +(* *) +(* This software is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) +(* *) +(**************************************************************************) + +module type G = sig + type t + val is_directed : bool + module V : Sig.COMPARABLE + module E : Sig.EDGE with type vertex = V.t + val iter_edges_e : (E.t -> unit) -> t -> unit +end + +(** The following implements Hierholzer's algorithm. + + It is sketched as follows: + + 1. make a round trip from a random vertex, by following random + edges until we get back to the starting point (it will, as we + first check that all vertices have even degrees). + + 2. if any vertex along this cycle still has outgoing edges, pick one + and make another round trip from it, and then join the two cycles + into a single one. Repeat step 2 until all edges are exhausted. + + The implementation makes use of the following: + + - A table, called `out` in the following, that maps each vertex to + outgoing edges not yet used in the Eulerian path. + + - In order to achieve optimal complexity, paths are built as + doubly-linked lists, so that we can merge two cycles with a common + vertex in constant time. This is type `dll` below. +*) + +module Make(G: G) = struct + + open G + + let rev e = + E.create (E.dst e) (E.label e) (E.src e) + + module H = Hashtbl.Make(V) + + type out = E.t H.t H.t + + let add_out_edge out x y e = + let s = try H.find out x + with Not_found -> let s = H.create 4 in H.add out x s; s in + H.add s y e + + (** compute the table of outgoing edges *) + let setup g : int * out = + let nbe = ref 0 in + let out = H.create 16 in + let add e = + incr nbe; + let x = E.src e and y = E.dst e in + add_out_edge out x y e; + if not is_directed && not (V.equal x y) then + add_out_edge out y x (rev e) in + iter_edges_e add g; + !nbe, out + + exception Found of V.t + let any h = + try H.iter (fun v _ -> raise (Found v)) h; assert false + with Found v -> v, H.find h v + + type dll = { mutable prev: dll; edge: E.t; mutable next: dll } + + let remove_edge out e = + let remove h x y = + let s = H.find h x in + assert (H.mem s y); + H.remove s y; + if H.length s = 0 then H.remove h x in + let v = E.src e and w = E.dst e in + remove out v w + + let self e = V.equal (E.src e) (E.dst e) + + let remove_edge edges e = + remove_edge edges e; + if not is_directed && not (self e) then remove_edge edges (rev e) + + let any_out_edge out v = + assert (H.mem out v); + let s = H.find out v in + assert (H.length s > 0); + let _, e = any s in + remove_edge out e; + e + + (** build an arbitrary cycle from vertex [start] *) + let round_trip edges start = + let e = any_out_edge edges start in + let rec path = { prev = path; edge = e; next = path } in + let rec tour e = + let v = E.dst e.edge in + if V.equal v start then ( + path.prev <- e; + path + ) else ( + let e' = { prev = e; edge = any_out_edge edges v; next = path } in + e.next <- e'; + tour e' + ) in + tour path + + let connect e e' = + e.next <- e'; + e'.prev <- e + + (** build an Eulerian cycle from vertex [start] *) + let eulerian_cycle out start = + let todos = H.create 8 in (* vertex on cycle with out edges -> cycle edge *) + let todo e = + let v = E.src e.edge in + if H.mem out v then H.replace todos v e else H.remove todos v in + let rec update start e = + todo e; + if not (V.equal (E.dst e.edge) start) then update start e.next in + let path = round_trip out start in + update start path; + while H.length todos > 0 do + let v, e = any todos in + H.remove todos v; + assert (H.mem out v); + let e' = round_trip out v in + update v e'; + let p = e.prev in + assert (p.next == e); + let p' = e'.prev in + assert (p'.next == e'); + connect p e'; + connect p' e; + done; + path + + let list_of path = + let rec convert acc e = + if e == path then List.rev acc else convert (e.edge :: acc) e.next in + convert [path.edge] path.next + + let mem_edge out x y = + try H.mem (H.find out x) y with Not_found -> false + + let out_degree out x = + try H.length (H.find out x) with Not_found -> 0 + + let undirected g = + let nbe, out = setup g in + let odds = H.create 2 in + let check v s = + let d = H.length s in + let d = if H.mem s v then d - 1 else d in + if d mod 2 = 1 then H.add odds v () in + H.iter check out; + let n = H.length odds in + if n <> 0 && n <> 2 then invalid_arg "Eulerian.path (bad degrees)"; + let cycle = n = 0 in + let path = + if cycle then + if nbe = 0 then [] + else let v, _ = any out in list_of (eulerian_cycle out v) + else ( + (* we have two vertices x and y with odd degrees *) + let x, _ = any odds in + H.remove odds x; + let y, _ = any odds in + + if mem_edge out x y then ( + (* there is an edge x--y => it connects 1 or 2 Eulerian cycles *) + let xy = H.find (H.find out x) y in + remove_edge out xy; + match out_degree out x, out_degree out y with + | 0, 0 -> [xy] + | _, 0 -> rev xy :: list_of (eulerian_cycle out x) + | 0, _ -> xy :: list_of (eulerian_cycle out y) + | _ -> + let py = eulerian_cycle out y in + (* caveat: the cycle from y may exhaust edges from x *) + if out_degree out x = 0 then xy :: list_of py + else list_of (eulerian_cycle out x) @ xy :: list_of py + (* a bit of a pity to use list concatenation here, + but this does not change the complexity *) + ) else ( + (* no edge x--y => add one, build a cycle, then remove it *) + let dummy = E.label (snd (any (H.find out x))) in + let xy = E.create x dummy y in + H.add (H.find out x) y xy; + H.add (H.find out y) x (rev xy); + let p = eulerian_cycle out x in + let rec find e = (* lookup for x--y, to break the cycle there *) + let v = E.src e.edge and w = E.dst e.edge in + if V.equal v x && V.equal w y || + V.equal v y && V.equal w x then e else find e.next in + let start = find p in + List.tl (list_of start) + ) + ) + in + (* check that all edges have been consumed *) + if H.length out > 0 then invalid_arg "Eulerian.path (not connected)"; + path, cycle + + let directed g = + let delta = H.create 16 in (* out - in *) + let add v d = + H.replace delta v (d + try H.find delta v with Not_found -> 0) in + let add e = + add (E.src e) 1; add (E.dst e) (-1) in + iter_edges_e add g; + let start = ref None and finish = ref None in + let check v = function + | 1 when !start = None -> start := Some v + | -1 when !finish = None -> finish := Some v + | 0 -> () + | _ -> invalid_arg "Eulerian.path (bad degrees)" in + H.iter check delta; + let nbe, out = setup g in + let path, cycle = match !start, !finish with + | None, None when nbe = 0 -> + [], true + | None, None -> + let v, _ = any out in list_of (eulerian_cycle out v), true + | Some s, Some f -> + (* add one edge f->s, build a cycle, then remove it + note: there may be already an edge f->s + if so, we are adding *a second one* and we are careful + about removing this one, not the other *) + let dummy = E.label (snd (any (H.find out s))) in + let fs = E.create f dummy s in + add_out_edge out f s fs; + let p = eulerian_cycle out s in + let rec find e = (* lookup for f->s, to break the cycle there *) + if e.edge == fs then e else find e.next in + let start = find p in + List.tl (list_of start), false + | Some _, None + | None, Some _ -> + assert false (* since the sum of all deltas is zero *) + in + (* check that all edges have been consumed *) + if H.length out > 0 then invalid_arg "Eulerian.path (not connected)"; + path, cycle + + let path = + if is_directed then directed else undirected + + let cycle g = + let p, c = path g in + if not c then invalid_arg "Eulerian.cycle"; + p + +end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/eulerian.mli new/ocaml-ocamlgraph-2.1.0/src/eulerian.mli --- old/ocaml-ocamlgraph-2.0.0/src/eulerian.mli 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-ocamlgraph-2.1.0/src/eulerian.mli 2023-08-30 10:35:17.000000000 +0200 @@ -0,0 +1,46 @@ +(**************************************************************************) +(* *) +(* Ocamlgraph: a generic graph library for OCaml *) +(* Copyright (C) 2004-2010 *) +(* Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles *) +(* *) +(* This software is free software; you can redistribute it and/or *) +(* modify it under the terms of the GNU Library General Public *) +(* License version 2.1, with the special exception on linking *) +(* described in file LICENSE. *) +(* *) +(* This software is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *) +(* *) +(**************************************************************************) + +(** Eulerian path + + This module implements Hierholzer's algorithm, with O(E) complexity + where E is the number of edges. + + Limitations: + - multigraphs are not supported + *) + +module type G = sig + type t + val is_directed : bool + module V : Sig.COMPARABLE + module E : Sig.EDGE with type vertex = V.t + val iter_edges_e : (E.t -> unit) -> t -> unit +end + +module Make(G: G) : sig + + val path: G.t -> G.E.t list * bool + (** [path g] returns an Eulerian path of [g]. The Boolean indicates + whether the path is a cycle. Raises [Invalid_argument] if there + is no Eulerian path. *) + + val cycle: G.t -> G.E.t list + (** [cycle g] returns an Eulerian cycle of [g]. + Raises [Invalid_argument] if there is no Eulerian cycle. *) + +end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/graph.ml new/ocaml-ocamlgraph-2.1.0/src/graph.ml --- old/ocaml-ocamlgraph-2.0.0/src/graph.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/graph.ml 2023-08-30 10:35:17.000000000 +0200 @@ -12,6 +12,7 @@ module Oper = Oper module Components = Components module Path = Path +module Cycles = Cycles module Nonnegative = Nonnegative module Traverse = Traverse module Coloring = Coloring diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/graphviz.ml new/ocaml-ocamlgraph-2.1.0/src/graphviz.ml --- old/ocaml-ocamlgraph-2.0.0/src/graphviz.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/graphviz.ml 2023-08-30 10:35:17.000000000 +0200 @@ -576,7 +576,7 @@ fprintf ppf "%t@ " print_nodes; fprintf ppf "%t@ " print_subgraphs; fprintf ppf "%t@ " print_edges; - fprintf ppf "@]}@]" + fprintf ppf "@]}@;@]" (** [output_graph oc graph] pretty prints the graph [graph] in the dot language on the channel [oc]. *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/imperative.ml new/ocaml-ocamlgraph-2.1.0/src/imperative.ml --- old/ocaml-ocamlgraph-2.0.0/src/imperative.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/imperative.ml 2023-08-30 10:35:17.000000000 +0200 @@ -477,15 +477,13 @@ (* map iterator on vertex *) let map_vertex f g = let n = nb_vertex g in + let f i = (* ensures f is applied exactly once for each vertex *) + let fi = f i in + if fi < 0 || fi >= n then invalid_arg "[ocamlgraph] map_vertex"; + fi in + let v = Array.init n f in let g' = make n in - iter_edges - (fun i j -> - let fi = f i in - let fj = f j in - if fi < 0 || fi >= n || fj < 0 || fj >= n then - invalid_arg "[ocamlgraph] map_vertex"; - Bitv.unsafe_set g'.(fi) fj true) - g; + iter_edges (fun i j -> Bitv.unsafe_set g'.(v.(i)) v.(j) true) g; g' (* labeled edges going from/to a vertex *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/pack.ml new/ocaml-ocamlgraph-2.1.0/src/pack.ml --- old/ocaml-ocamlgraph-2.0.0/src/pack.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/pack.ml 2023-08-30 10:35:17.000000000 +0200 @@ -93,6 +93,10 @@ let iter_stable = S.iter end + module Eulerian = struct + include Eulerian.Make(G) + end + module Int = struct type t = int let compare : t -> t -> int = Stdlib.compare diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/path.ml new/ocaml-ocamlgraph-2.1.0/src/path.ml --- old/ocaml-ocamlgraph-2.0.0/src/path.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/path.ml 2023-08-30 10:35:17.000000000 +0200 @@ -327,6 +327,9 @@ (* the path is not in cache; we check it with a BFS *) let visited = HV.create 97 in let q = Queue.create () in + (* [visited] contains exactly the vertices that have been added to [q] *) + let push v = + if not (HV.mem visited v) then (HV.add visited v (); Queue.add v q) in let rec loop () = if Queue.is_empty q then begin HVV.add pc.cache (v1, v2) false; @@ -337,15 +340,12 @@ if G.V.compare v v2 = 0 then true else begin - if not (HV.mem visited v) then begin - HV.add visited v (); - G.iter_succ (fun v' -> Queue.add v' q) pc.graph v - end; + G.iter_succ push pc.graph v; loop () end end in - Queue.add v1 q; + push v1; loop () end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/path.mli new/ocaml-ocamlgraph-2.1.0/src/path.mli --- old/ocaml-ocamlgraph-2.0.0/src/path.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/path.mli 2023-08-30 10:35:17.000000000 +0200 @@ -142,8 +142,8 @@ Complexity: The path checker contains a cache of all results computed so far. This cache is implemented with a hash table so access in this - cache is usually O(1). When the result is not in the cache, Dijkstra's - algorithm is run to check for the path, and all intermediate results + cache is usually O(1). When the result is not in the cache, a BFS + is run to check for the path, and all intermediate results are cached. Note: if checks are to be done for almost all pairs of vertices, it diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/sig.mli new/ocaml-ocamlgraph-2.1.0/src/sig.mli --- old/ocaml-ocamlgraph-2.0.0/src/sig.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/sig.mli 2023-08-30 10:35:17.000000000 +0200 @@ -189,7 +189,13 @@ (** Fold on all edges of a graph. *) val map_vertex : (vertex -> vertex) -> t -> t - (** Map on all vertices of a graph. *) + (** Map on all vertices of a graph. + + The current implementation requires the supplied function to be + injective. Said otherwise, [map_vertex] cannot be used to contract + a graph by mapping several vertices to the same vertex. + To contract a graph, use instead [create], [add_vertex], + and [add_edge]. *) (** {2 Vertex iterators} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/sig_pack.mli new/ocaml-ocamlgraph-2.1.0/src/sig_pack.mli --- old/ocaml-ocamlgraph-2.0.0/src/sig_pack.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/sig_pack.mli 2023-08-30 10:35:17.000000000 +0200 @@ -344,6 +344,18 @@ (** [full n] builds a graph with [n] vertices and all possible edges. The optional argument [self] indicates if loop edges should be added (default value is [true]). *) + + val cycle : int -> t * V.t array + (** [cycle n] builds a graph that is a cycle with [n] vertices. + Vertices are labelled with 0,1,...,n-1 and there is an edge from + vertex [i] to vertex [(i+1) mod n]. + Vertices are also returned in an array for convenience. *) + + val grid : n:int -> m:int -> t * V.t array array + (** [grid n m] builds a grid graph with [n*m] vertices, with edges + from vertex [(i,j)] to vertices [(i+1,j)] and [(i,j+1)] (and no + wrapping around). Vertex [(i,j)] is labelled with [i*m+j]. + Vertices are also returned in a [n*m] matrix for convenience. *) end (** Random graphs *) @@ -409,6 +421,16 @@ val iter_stable : (V.t -> unit) -> t -> unit end + (** Eulerian path *) + module Eulerian : sig + val path: t -> E.t list * bool + (** [path g] returns an Eulerian path of g. The Boolean indicates + whether the path is a cycle. Raises [Invalid_argument] if there is + no Eulerian path. *) + + val cycle: t -> E.t list + end + val spanningtree : t -> E.t list (** Kruskal algorithm *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/traverse.ml new/ocaml-ocamlgraph-2.1.0/src/traverse.ml --- old/ocaml-ocamlgraph-2.0.0/src/traverse.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/traverse.ml 2023-08-30 10:35:17.000000000 +0200 @@ -31,22 +31,23 @@ 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 @@ 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/traverse.mli new/ocaml-ocamlgraph-2.1.0/src/traverse.mli --- old/ocaml-ocamlgraph-2.0.0/src/traverse.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/traverse.mli 2023-08-30 10:35:17.000000000 +0200 @@ -17,7 +17,22 @@ (** Graph traversal. *) -(** {2 Dfs and Bfs} *) +(** {2 Dfs and Bfs} + + In the modules below, the most meaningful functions are the + [iter/fold_component] functions, where the starting point of the + traversal is user-provided. + + Functions [iter/fold] to traverse the whole graph are also + provided, for convenience, and they proceed as follows: they run + the user-provided [iter/fold_vertex] functions (from input module + [G]) and, for each vertex not yet visited, start a new traversal + from this vertex. In particular, each traversal is not necessarily + started from a vertex without predecessors. Said otherwise, it is + up to you to come up with an [iter_vertex] function that will + identify suitable roots, e.g. vertices with no predecessors, if + this is really what you want. +*) (** Minimal graph signature for {!Dfs} and {!Bfs}. Sub-signature of {!Sig.G}. *) @@ -27,11 +42,13 @@ module V : Sig.COMPARABLE val iter_vertex : (V.t -> unit) -> t -> unit (** It is enough to iter over all the roots (vertices without predecessor) of - the graph, even if iterating over the other vertices is correct. *) + the graph, even if iterating over the other vertices is correct. + (See the comment above.) *) val fold_vertex : (V.t -> 'a -> 'a) -> t -> 'a -> 'a (** It is enough to fold over all the roots (vertices without predecessor) of - the graph, even if folding over the other vertices is correct. *) + the graph, even if folding over the other vertices is correct. + (See the comment above.) *) val iter_succ : (V.t -> unit) -> t -> V.t -> unit val fold_succ : (V.t -> 'a -> 'a) -> t -> V.t -> 'a -> 'a @@ -68,7 +85,7 @@ val fold : (G.V.t -> 'a -> 'a) -> 'a -> G.t -> 'a (** The function is applied each time a node is reached for the first time, - before idoterating over its successors. Tail-recursive. *) + before iterating over its successors. Tail-recursive. *) val fold_component : (G.V.t -> 'a -> 'a) -> 'a -> G.t -> G.V.t -> 'a (** Idem, but limited to a single root vertex. *) @@ -102,12 +119,20 @@ (** {2 Classical big-step iterators} *) val iter : (G.V.t -> unit) -> G.t -> unit + (** The function is applied each time a node is reached for the first time. + Not tail-recursive. *) + val iter_component : (G.V.t -> unit) -> G.t -> G.V.t -> unit + (** Idem, but limited to a single root vertex. *) (** {2 Classical folds} *) val fold : (G.V.t -> 'a -> 'a) -> 'a -> G.t -> 'a + (** The function is applied each time a node is reached for the first time. + Not tail-recursive. *) + val fold_component : (G.V.t -> 'a -> 'a) -> 'a -> G.t -> G.V.t -> 'a + (** Idem, but limited to a single root vertex. *) (** {2 Step-by-step iterator} See module [Dfs] *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/util.ml new/ocaml-ocamlgraph-2.1.0/src/util.ml --- old/ocaml-ocamlgraph-2.0.0/src/util.ml 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/util.ml 2023-08-30 10:35:17.000000000 +0200 @@ -48,3 +48,9 @@ let set_data (y, _) = (:=) y end +module Memo(X: HASHABLE) = struct + module H = Hashtbl.Make(X) + let memo ?(size=128) f = + let h = H.create size in + fun x -> try H.find h x with Not_found -> let y = f x in H.add h x y; y +end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-ocamlgraph-2.0.0/src/util.mli new/ocaml-ocamlgraph-2.1.0/src/util.mli --- old/ocaml-ocamlgraph-2.0.0/src/util.mli 2020-10-02 15:47:57.000000000 +0200 +++ new/ocaml-ocamlgraph-2.1.0/src/util.mli 2023-08-30 10:35:17.000000000 +0200 @@ -45,3 +45,6 @@ val set_data : t -> data -> unit end +module Memo(X: HASHABLE) : sig + val memo: ?size:int -> (X.t -> 'a) -> X.t -> 'a +end