From 5e444dd278cfd26dc75adb3f65b026ed3e2d7f92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Mon, 6 Jan 2020 18:26:24 +0100 Subject: [PATCH] update union-find library (part 1: remove old copy, download https://github.com/rinderknecht/UnionFind.git 3fc434d0d75e40d40d17f5abb70d86a51f434771 in new folder) --- src/union_find/Partition3.ml | 86 ---------------- src/union_find/dune | 17 ---- src/union_find/union_find.ml | 2 - .../UnionFind}/.PartitionMain.tag | 0 {src/union_find => vendors/UnionFind}/.links | 0 {src/union_find => vendors/UnionFind}/LICENSE | 0 .../UnionFind}/Makefile.cfg | 0 .../UnionFind}/Partition.mli | 22 +++-- .../UnionFind}/Partition0.ml | 28 +++--- .../UnionFind}/Partition1.ml | 26 +++-- .../UnionFind}/Partition2.ml | 25 +++-- vendors/UnionFind/Partition3.ml | 99 +++++++++++++++++++ .../UnionFind}/PartitionMain.ml | 35 ++++--- .../UnionFind}/README.md | 0 .../union_find => vendors/UnionFind}/build.sh | 0 .../union_find => vendors/UnionFind}/clean.sh | 0 vendors/UnionFind/dune | 11 +++ vendors/UnionFind/dune-project | 1 + vendors/UnionFind/partition.opam | 19 ++++ 19 files changed, 211 insertions(+), 160 deletions(-) delete mode 100644 src/union_find/Partition3.ml delete mode 100644 src/union_find/dune delete mode 100644 src/union_find/union_find.ml rename {src/union_find => vendors/UnionFind}/.PartitionMain.tag (100%) rename {src/union_find => vendors/UnionFind}/.links (100%) rename {src/union_find => vendors/UnionFind}/LICENSE (100%) rename {src/union_find => vendors/UnionFind}/Makefile.cfg (100%) rename {src/union_find => vendors/UnionFind}/Partition.mli (70%) rename {src/union_find => vendors/UnionFind}/Partition0.ml (55%) rename {src/union_find => vendors/UnionFind}/Partition1.ml (69%) rename {src/union_find => vendors/UnionFind}/Partition2.ml (85%) create mode 100644 vendors/UnionFind/Partition3.ml rename {src/union_find => vendors/UnionFind}/PartitionMain.ml (54%) rename {src/union_find => vendors/UnionFind}/README.md (100%) rename {src/union_find => vendors/UnionFind}/build.sh (100%) rename {src/union_find => vendors/UnionFind}/clean.sh (100%) create mode 100644 vendors/UnionFind/dune create mode 100644 vendors/UnionFind/dune-project create mode 100644 vendors/UnionFind/partition.opam diff --git a/src/union_find/Partition3.ml b/src/union_find/Partition3.ml deleted file mode 100644 index 593292025..000000000 --- a/src/union_find/Partition3.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* Destructive implementation of union/find with height-balanced - forests but without path compression: O(n*log(n)). *) - -module Make (Item: Partition.Item) = - struct - - type item = Item.t - type repr = item (** Class representatives *) - - let equal i j = Item.compare i j = 0 - - type height = int - - (** Each equivalence class is implemented by a Catalan tree linked - upwardly and otherwise is a link to another node. Those trees - are height-balanced. The type [node] implements nodes in those - trees. *) - type node = {item: item; mutable height: int; mutable parent: node} - - module ItemMap = Map.Make (Item) - - (** The type [partition] implements a partition of classes of - equivalent items by means of a map from items to nodes of type - [node] in trees. *) - type partition = node ItemMap.t - - type t = partition - - let empty = ItemMap.empty - - (** The function [repr] is faster than a persistent implementation - in the worst case because, in the latter case, the cost is O(log n) - for accessing each node in the path to the root, whereas, in the - former, only the access to the first node in the path incurs a cost - of O(log n) -- the other nodes are accessed in constant time by - following the [next] field of type [node]. *) - let seek (i: item) (p: partition) : node = - let rec find_root node = - if node.parent == node then node else find_root node.parent - in find_root (ItemMap.find i p) - - let repr item partition = (seek item partition).item - - let is_equiv (i: item) (j: item) (p: partition) = - equal (repr i p) (repr j p) - - let get_or_set item (p: partition) = - try seek item p, p with - Not_found -> let rec loop = {item; height=0; parent=loop} - in loop, ItemMap.add item loop p - - let link src dst = src.parent <- dst - - let equiv (i: item) (j: item) (p: partition) : partition = - let ni,p = get_or_set i p in - let nj,p = get_or_set j p in - let hi,hj = ni.height, nj.height in - let () = - if not (equal ni.item nj.item) - then if hi > hj - then link nj ni - else (link ni nj; nj.height <- max hj (hi+1)) - in p - - let alias (i: item) (j: item) (p: partition) : partition = - let ni,p = get_or_set i p in - let nj,p = get_or_set j p in - let hi,hj = ni.height, nj.height in - let () = - if not (equal ni.item nj.item) - then if hi = hj || equal ni.item i - then (link ni nj; nj.height <- max hj (hi+1)) - else if hi < hj then link ni nj - else link nj ni - in p - - (* Printing *) - - let print p = - let print _ node = - Printf.printf "%s,%d -> %s,%d\n" - (Item.to_string node.item) node.height - (Item.to_string node.parent.item) node.parent.height - in ItemMap.iter print p - - end diff --git a/src/union_find/dune b/src/union_find/dune deleted file mode 100644 index 711614f28..000000000 --- a/src/union_find/dune +++ /dev/null @@ -1,17 +0,0 @@ -(library - (name union_find) - (public_name ligo.union_find) - (wrapped false) ;; TODO: do we need this? - (modules Partition0 Partition1 Partition2 Partition3 Partition Union_find) - (modules_without_implementation Partition) -;; (preprocess -;; (pps simple-utils.ppx_let_generalized) -;; ) -;; (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) - ) - -;;; TODO test does not test anything, only prints -; (test -; (modules PartitionMain) -; (libraries union_find) -; (name PartitionMain)) diff --git a/src/union_find/union_find.ml b/src/union_find/union_find.ml deleted file mode 100644 index 17850f743..000000000 --- a/src/union_find/union_find.ml +++ /dev/null @@ -1,2 +0,0 @@ -module Partition = Partition -module Partition0 = Partition0 diff --git a/src/union_find/.PartitionMain.tag b/vendors/UnionFind/.PartitionMain.tag similarity index 100% rename from src/union_find/.PartitionMain.tag rename to vendors/UnionFind/.PartitionMain.tag diff --git a/src/union_find/.links b/vendors/UnionFind/.links similarity index 100% rename from src/union_find/.links rename to vendors/UnionFind/.links diff --git a/src/union_find/LICENSE b/vendors/UnionFind/LICENSE similarity index 100% rename from src/union_find/LICENSE rename to vendors/UnionFind/LICENSE diff --git a/src/union_find/Makefile.cfg b/vendors/UnionFind/Makefile.cfg similarity index 100% rename from src/union_find/Makefile.cfg rename to vendors/UnionFind/Makefile.cfg diff --git a/src/union_find/Partition.mli b/vendors/UnionFind/Partition.mli similarity index 70% rename from src/union_find/Partition.mli rename to vendors/UnionFind/Partition.mli index 657b3c007..03df3caa1 100644 --- a/src/union_find/Partition.mli +++ b/vendors/UnionFind/Partition.mli @@ -43,21 +43,29 @@ module type S = (** {1 Projection} *) - (** The value of the call [repr i p] is the representative of item - [i] in the partition [p]. The built-in exception [Not_found] - is raised if [i] is not in [p]. *) + (** The value of the call [repr i p] is [j] if the item [i] is in + the partition [p] and its representative is [j]. If [i] is not + in [p], then the value is [i]. *) val repr : item -> partition -> item - (** The side-effect of the call [print p] is the printing of the - partition [p] on standard output, based on [Ord.to_string]. *) - val print : partition -> unit + (** The value of the call [mem i p] is [Some j] if the item [i] is + in the partition [p] and its representative is [j]. If [i] is + not in [p], then the value is [None]. *) + val mem : item -> partition -> item option + + (** The call [print p] is a value of type [Buffer.t] containing + strings denoting the partition [p], based on + [Ord.to_string]. *) + val print : partition -> Buffer.t (** {1 Predicates} *) (** The value of [is_equiv i j p] is [true] if, and only if, the items [i] and [j] belong to the same equivalence class in the partition [p], that is, [i] and [j] have the same - representative. *) + representative. In particular, if either [i] or [j] do not + belong to [p], the value of [is_equiv i j p] is [false]. See + [mem] above. *) val is_equiv : item -> item -> partition -> bool end diff --git a/src/union_find/Partition0.ml b/vendors/UnionFind/Partition0.ml similarity index 55% rename from src/union_find/Partition0.ml rename to vendors/UnionFind/Partition0.ml index 968bb8dd4..cd8b26ffc 100644 --- a/src/union_find/Partition0.ml +++ b/vendors/UnionFind/Partition0.ml @@ -2,34 +2,34 @@ module Make (Item: Partition.Item) = struct - type item = Item.t - type repr = item (** Class representatives *) let equal i j = Item.compare i j = 0 module ItemMap = Map.Make (Item) - type height = int - type partition = item ItemMap.t type t = partition let empty = ItemMap.empty - let rec repr item partition = + let rec repr item partition : item = let parent = ItemMap.find item partition in if equal parent item then item else repr parent partition - let is_equiv (i: item) (j: item) (p: partition) = - equal (repr i p) (repr j p) + let is_equiv (i: item) (j: item) (p: partition) : bool = + try equal (repr i p) (repr j p) with Not_found -> false let get_or_set (i: item) (p: partition) : item * partition = try repr i p, p with Not_found -> i, ItemMap.add i i p - let equiv (i: item) (j :item) (p: partition) : partition = + let mem i p = try Some (repr i p) with Not_found -> None + + let repr i p = try repr i p with Not_found -> i + + let equiv (i: item) (j: item) (p: partition) : partition = let ri, p = get_or_set i p in let rj, p = get_or_set j p in if equal ri rj then p else ItemMap.add ri rj p @@ -38,10 +38,12 @@ module Make (Item: Partition.Item) = (* Printing *) - let print p = + let print (p: partition) = + let buffer = Buffer.create 80 in let print src dst = - Printf.printf "%s -> %s\n" - (Item.to_string src) (Item.to_string dst) - in ItemMap.iter print p - + let link = + Printf.sprintf "%s -> %s\n" + (Item.to_string src) (Item.to_string dst) + in Buffer.add_string buffer link + in (ItemMap.iter print p; buffer) end diff --git a/src/union_find/Partition1.ml b/vendors/UnionFind/Partition1.ml similarity index 69% rename from src/union_find/Partition1.ml rename to vendors/UnionFind/Partition1.ml index 764d98d49..7d9320af2 100644 --- a/src/union_find/Partition1.ml +++ b/vendors/UnionFind/Partition1.ml @@ -1,5 +1,5 @@ (* Persistent implementation of Union/Find with height-balanced - forests and without path compression: O(n*log(n)). + forests and no path compression: O(n*log(n)). In the definition of type [t], the height component is that of the source, that is, if [ItemMap.find i m = (j,h)], then [h] is the @@ -10,7 +10,6 @@ module Make (Item: Partition.Item) = struct type item = Item.t - type repr = item (** Class representatives *) let equal i j = Item.compare i j = 0 @@ -23,18 +22,22 @@ module Make (Item: Partition.Item) = let empty = ItemMap.empty - let rec seek (i: item) (p: partition) : repr * height = + let rec seek (i: item) (p: partition) : item * height = let j, _ as i' = ItemMap.find i p in if equal i j then i' else seek j p - let repr item partition = fst (seek item partition) + let repr i p = fst (seek i p) - let is_equiv (i: item) (j: item) (p: partition) = - equal (repr i p) (repr j p) + let is_equiv (i: item) (j: item) (p: partition) : bool = + try equal (repr i p) (repr j p) with Not_found -> false let get_or_set (i: item) (p: partition) = try seek i p, p with - Not_found -> let i' = i,0 in (i', ItemMap.add i i' p) + Not_found -> let i' = i,0 in i', ItemMap.add i i' p + + let mem i p = try Some (repr i p) with Not_found -> None + + let repr i p = try repr i p with Not_found -> i let equiv (i: item) (j: item) (p: partition) : partition = let (ri,hi), p = get_or_set i p in @@ -60,10 +63,13 @@ module Make (Item: Partition.Item) = (* Printing *) let print (p: partition) = + let buffer = Buffer.create 80 in let print i (j,hi) = let _,hj = ItemMap.find j p in - Printf.printf "%s,%d -> %s,%d\n" - (Item.to_string i) hi (Item.to_string j) hj - in ItemMap.iter print p + let link = + Printf.sprintf "%s,%d -> %s,%d\n" + (Item.to_string i) hi (Item.to_string j) hj + in Buffer.add_string buffer link + in ItemMap.iter print p; buffer end diff --git a/src/union_find/Partition2.ml b/vendors/UnionFind/Partition2.ml similarity index 85% rename from src/union_find/Partition2.ml rename to vendors/UnionFind/Partition2.ml index e1372b2fd..ef2f7e770 100644 --- a/src/union_find/Partition2.ml +++ b/vendors/UnionFind/Partition2.ml @@ -1,11 +1,10 @@ (** Persistent implementation of the Union/Find algorithm with - height-balanced forests and without path compression. *) + height-balanced forests and no path compression. *) module Make (Item: Partition.Item) = struct type item = Item.t - type repr = item (** Class representatives *) let equal i j = Item.compare i j = 0 @@ -55,20 +54,25 @@ module Make (Item: Partition.Item) = let link (src, height) dst = ItemMap.add src (Link (dst, height)) - let rec seek (i: item) (p: partition) : repr * height = + let rec seek (i: item) (p: partition) : item * height = match ItemMap.find i p with Root hi -> i,hi | Link (j,_) -> seek j p - let repr item partition = fst (seek item partition) + let repr i p = fst (seek i p) - let is_equiv (i: item) (j: item) (p: partition) = - equal (repr i p) (repr j p) + let is_equiv (i: item) (j: item) (p: partition) : bool = + try equal (repr i p) (repr j p) with + Not_found -> false let get_or_set (i: item) (p: partition) = try seek i p, p with Not_found -> let n = i,0 in (n, root n p) + let mem i p = try Some (repr i p) with Not_found -> None + + let repr i p = try repr i p with Not_found -> i + let equiv (i: item) (j: item) (p: partition) : partition = let (ri,hi as ni), p = get_or_set i p in let (rj,hj as nj), p = get_or_set j p in @@ -101,6 +105,7 @@ module Make (Item: Partition.Item) = (** {1 Printing} *) let print (p: partition) = + let buffer = Buffer.create 80 in let print i node = let hi, hj, j = match node with @@ -108,8 +113,10 @@ module Make (Item: Partition.Item) = | Link (j,hi) -> match ItemMap.find j p with Root hj | Link (_,hj) -> hi,hj,j in - Printf.printf "%s,%d -> %s,%d\n" - (Item.to_string i) hi (Item.to_string j) hj - in ItemMap.iter print p + let link = + Printf.sprintf "%s,%d -> %s,%d\n" + (Item.to_string i) hi (Item.to_string j) hj + in Buffer.add_string buffer link + in ItemMap.iter print p; buffer end diff --git a/vendors/UnionFind/Partition3.ml b/vendors/UnionFind/Partition3.ml new file mode 100644 index 000000000..42fcd7a4c --- /dev/null +++ b/vendors/UnionFind/Partition3.ml @@ -0,0 +1,99 @@ +(* Destructive implementation of union/find with height-balanced + forests but without path compression: O(n*log(n)). *) + +module Make (Item: Partition.Item) = + struct + + type item = Item.t + + let equal i j = Item.compare i j = 0 + + type height = int + + (** Each equivalence class is implemented by a Catalan tree linked + upwardly and otherwise is a link to another node. Those trees + are height-balanced. The type [node] implements nodes in those + trees. *) + type node = { + item : item; + mutable height : int; + mutable parent : node + } + + module ItemMap = Map.Make (Item) + + (** The type [partition] implements a partition of classes of + equivalent items by means of a map from items to nodes of type + [node] in trees. *) + type partition = node ItemMap.t + + type t = partition + + let empty = ItemMap.empty + + (** The impure function [repr] is faster than a pure + implementation in the worst case because, in the latter case, + the cost is O(log n) for accessing each node in the path to + the root, whereas, in the former, only the access to the first + node in the path incurs a cost of O(log n) -- the other nodes + are accessed in constant time by following the [next] field of + type [node]. *) + let seek (i: item) (p: partition) : node = + let rec find_root node = + if node.parent == node then node else find_root node.parent + in find_root (ItemMap.find i p) + + let repr i p = (seek i p).item + + let is_equiv (i: item) (j: item) (p: partition) : bool = + try equal (repr i p) (repr j p) with + Not_found -> false + + let get_or_set item (p: partition) = + try seek item p, p with + Not_found -> + let rec loop = {item; height=0; parent=loop} + in loop, ItemMap.add item loop p + + let mem i p = try Some (repr i p) with Not_found -> None + + let repr i p = try repr i p with Not_found -> i + + let link src dst = src.parent <- dst + + let equiv (i: item) (j: item) (p: partition) : partition = + let ni,p = get_or_set i p in + let nj,p = get_or_set j p in + let hi,hj = ni.height, nj.height in + let () = + if not (equal ni.item nj.item) + then if hi > hj + then link nj ni + else (link ni nj; nj.height <- max hj (hi+1)) + in p + + let alias (i: item) (j: item) (p: partition) : partition = + let ni,p = get_or_set i p in + let nj,p = get_or_set j p in + let hi,hj = ni.height, nj.height in + let () = + if not (equal ni.item nj.item) + then if hi = hj || equal ni.item i + then (link ni nj; nj.height <- max hj (hi+1)) + else if hi < hj then link ni nj + else link nj ni + in p + + (* Printing *) + + let print (p: partition) = + let buffer = Buffer.create 80 in + let print _ node = + let link = + Printf.sprintf "%s,%d -> %s,%d\n" + (Item.to_string node.item) node.height + (Item.to_string node.parent.item) node.parent.height + in Buffer.add_string buffer link + in ItemMap.iter print p; buffer + + end diff --git a/src/union_find/PartitionMain.ml b/vendors/UnionFind/PartitionMain.ml similarity index 54% rename from src/union_find/PartitionMain.ml rename to vendors/UnionFind/PartitionMain.ml index 4e69dbd87..cc36b092a 100644 --- a/src/union_find/PartitionMain.ml +++ b/vendors/UnionFind/PartitionMain.ml @@ -9,22 +9,25 @@ module Test (Part: Partition.S with type item = Int.t) = struct open Part - let () = empty - |> equiv 4 3 - |> equiv 3 8 - |> equiv 6 5 - |> equiv 9 4 - |> equiv 2 1 - |> equiv 8 9 - |> equiv 5 0 - |> equiv 7 2 - |> equiv 6 1 - |> equiv 1 0 - |> equiv 6 7 - |> equiv 8 0 - |> equiv 7 7 - |> equiv 10 10 - |> print + let () = + empty + |> equiv 4 3 + |> equiv 3 8 + |> equiv 6 5 + |> equiv 9 4 + |> equiv 2 1 + |> equiv 8 9 + |> equiv 5 0 + |> equiv 7 2 + |> equiv 6 1 + |> equiv 1 0 + |> equiv 6 7 + |> equiv 8 0 + |> equiv 7 7 + |> equiv 10 10 + |> print + |> Buffer.contents + |> print_string end diff --git a/src/union_find/README.md b/vendors/UnionFind/README.md similarity index 100% rename from src/union_find/README.md rename to vendors/UnionFind/README.md diff --git a/src/union_find/build.sh b/vendors/UnionFind/build.sh similarity index 100% rename from src/union_find/build.sh rename to vendors/UnionFind/build.sh diff --git a/src/union_find/clean.sh b/vendors/UnionFind/clean.sh similarity index 100% rename from src/union_find/clean.sh rename to vendors/UnionFind/clean.sh diff --git a/vendors/UnionFind/dune b/vendors/UnionFind/dune new file mode 100644 index 000000000..8fe8caa93 --- /dev/null +++ b/vendors/UnionFind/dune @@ -0,0 +1,11 @@ +(library + (name UnionFind) + (public_name partition) + (wrapped false) + (modules Partition0 Partition1 Partition2 Partition3 Partition) + (modules_without_implementation Partition)) + +(test + (modules PartitionMain) + (libraries UnionFind) + (name PartitionMain)) diff --git a/vendors/UnionFind/dune-project b/vendors/UnionFind/dune-project new file mode 100644 index 000000000..43a1282a9 --- /dev/null +++ b/vendors/UnionFind/dune-project @@ -0,0 +1 @@ +(lang dune 1.7) diff --git a/vendors/UnionFind/partition.opam b/vendors/UnionFind/partition.opam new file mode 100644 index 000000000..58888bcee --- /dev/null +++ b/vendors/UnionFind/partition.opam @@ -0,0 +1,19 @@ +opam-version : "2.0" +version : "1.0" +maintainer : "rinderknecht@free.fr" +authors : [ "Christian Rinderknecht" ] +homepage : "https://gitlab.com/rinderknecht/UnionFind" +bug-reports : "https://gitlab.com/rinderknecht/UnionFind/issues" +dev-repo : "git+https://gitlab.com/rinderknecht/UnionFind.git" +license : "MIT" + +depends : [ "dune" ] + +build : [ + [ "sh" "-c" "printf 'let version = \"%s\"' \"$(git describe --always --dirty --abbrev=0)\" > Version.ml" ] + [ "dune" "build" "-p" name "-j" jobs ] + ] + +url { + src: "https://gitlab.com/rinderknecht/UnionFind/-/archive/master/UnionFind.tar.gz" +}