suzanne.soy/UnionFind
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

The function [repr] returns now an optional value instead of raising an exception.

Browse Source 
Also, [is_equiv] does not raise an exception anymore.
This commit is contained in:
Christian Rinderknecht 2019-10-19 19:39:25 +02:00
parent 3296b0eb48
commit 43eb5dd13f
6 changed files with 122 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Partition.mli
View File

@ -43,21 +43,22 @@ module type S =
(** {1 Projection} *) (** {1 Projection} *)
(** The value of the call [repr i p] is the representative of item (** The value of the call [repr i p] is [Some j], if the item [i]
[i] in the partition [p]. The built-in exception [Not_found] is in the partition [p] and its representative is [j]. If [i]
is raised if [i] is not in [p]. *) is not in [p], then the value is [None]. *)
val repr : item -> partition -> item val repr : item -> partition -> item option
(** The side-effect of the call [print p] is the printing of the (** The side-effect of the call [print p] is the printing of the
partition [p] on standard output, based on [Ord.to_string]. *) partition [p] on a buffer, based on [Ord.to_string]. *)
val print : partition -> unit val print : partition -> Buffer.t
(** {1 Predicates} *) (** {1 Predicates} *)
(** The value of [is_equiv i j p] is [true] if, and only if, the (** 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 items [i] and [j] belong to the same equivalence class in the
partition [p], that is, [i] and [j] have the same 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].*)
val is_equiv : item -> item -> partition -> bool val is_equiv : item -> item -> partition -> bool
end end

24
Partition0.ml
View File

@ -4,7 +4,6 @@ module Make (Item: Partition.Item) =
struct struct
type item = Item.t type item = Item.t
type repr = item (** Class representatives *)
let equal i j = Item.compare i j = 0 let equal i j = Item.compare i j = 0
@ -17,19 +16,23 @@ module Make (Item: Partition.Item) =
let empty = ItemMap.empty let empty = ItemMap.empty
let rec repr item partition = let rec repr item partition : item =
let parent = ItemMap.find item partition in let parent = ItemMap.find item partition in
if equal parent item if equal parent item
then item then item
else repr parent partition else repr parent partition
let is_equiv (i: item) (j: item) (p: partition) = let is_equiv (i: item) (j: item) (p: partition) : bool =
equal (repr i p) (repr j p) try equal (repr i p) (repr j p) with
Not_found -> false
let get_or_set (i: item) (p: partition) : item * partition = let get_or_set (i: item) (p: partition) : item * partition =
try repr i p, p with Not_found -> i, ItemMap.add i i p try repr i p, p with Not_found -> i, ItemMap.add i i p
let equiv (i: item) (j :item) (p: partition) : partition = let repr item partition =
try Some (repr item partition) with Not_found -> None
let equiv (i: item) (j: item) (p: partition) : partition =
let ri, p = get_or_set i p in let ri, p = get_or_set i p in
let rj, p = get_or_set j p in let rj, p = get_or_set j p in
if equal ri rj then p else ItemMap.add ri rj p if equal ri rj then p else ItemMap.add ri rj p
@ -38,10 +41,13 @@ module Make (Item: Partition.Item) =
(* Printing *) (* Printing *)
let print p = let print (p: partition) =
let buffer = Buffer.create 80 in
let print src dst = let print src dst =
Printf.printf "%s -> %s\n" let link =
(Item.to_string src) (Item.to_string dst) Printf.sprintf "%s -> %s\n"
in ItemMap.iter print p (Item.to_string src) (Item.to_string dst)
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end end

20
Partition1.ml
View File

@ -10,7 +10,6 @@ module Make (Item: Partition.Item) =
struct struct
type item = Item.t type item = Item.t
type repr = item (** Class representatives *)
let equal i j = Item.compare i j = 0 let equal i j = Item.compare i j = 0
@ -23,14 +22,18 @@ module Make (Item: Partition.Item) =
let empty = ItemMap.empty 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 let j, _ as i' = ItemMap.find i p in
if equal i j then i' else seek j p if equal i j then i' else seek j p
let repr item partition = fst (seek item partition) let repr item partition = fst (seek item partition)
let is_equiv (i: item) (j: item) (p: partition) = let is_equiv (i: item) (j: item) (p: partition) : bool =
equal (repr i p) (repr j p) try equal (repr i p) (repr j p) with
Not_found -> false
let repr item partition =
try Some (repr item partition) with Not_found -> None
let get_or_set (i: item) (p: partition) = let get_or_set (i: item) (p: partition) =
try seek i p, p with try seek i p, p with
@ -60,10 +63,13 @@ module Make (Item: Partition.Item) =
(* Printing *) (* Printing *)
let print (p: partition) = let print (p: partition) =
let buffer = Buffer.create 80 in
let print i (j,hi) = let print i (j,hi) =
let _,hj = ItemMap.find j p in let _,hj = ItemMap.find j p in
Printf.printf "%s,%d -> %s,%d\n" let link =
(Item.to_string i) hi (Item.to_string j) hj Printf.sprintf "%s,%d -> %s,%d\n"
in ItemMap.iter print p (Item.to_string i) hi (Item.to_string j) hj
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end end

20
Partition2.ml
View File

@ -5,7 +5,6 @@ module Make (Item: Partition.Item) =
struct struct
type item = Item.t type item = Item.t
type repr = item (** Class representatives *)
let equal i j = Item.compare i j = 0 let equal i j = Item.compare i j = 0
@ -55,15 +54,19 @@ module Make (Item: Partition.Item) =
let link (src, height) dst = ItemMap.add src (Link (dst, height)) 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 match ItemMap.find i p with
Root hi -> i,hi Root hi -> i,hi
| Link (j,_) -> seek j p | Link (j,_) -> seek j p
let repr item partition = fst (seek item partition) let repr item partition = fst (seek item partition)
let is_equiv (i: item) (j: item) (p: partition) = let is_equiv (i: item) (j: item) (p: partition) : bool =
equal (repr i p) (repr j p) try equal (repr i p) (repr j p) with
Not_found -> false
let repr item partition =
try Some (repr item partition) with Not_found -> None
let get_or_set (i: item) (p: partition) = let get_or_set (i: item) (p: partition) =
try seek i p, p with try seek i p, p with
@ -101,6 +104,7 @@ module Make (Item: Partition.Item) =
(** {1 Printing} *) (** {1 Printing} *)
let print (p: partition) = let print (p: partition) =
let buffer = Buffer.create 80 in
let print i node = let print i node =
let hi, hj, j = let hi, hj, j =
match node with match node with
@ -108,8 +112,10 @@ module Make (Item: Partition.Item) =
| Link (j,hi) -> | Link (j,hi) ->
match ItemMap.find j p with match ItemMap.find j p with
Root hj | Link (_,hj) -> hi,hj,j in Root hj | Link (_,hj) -> hi,hj,j in
Printf.printf "%s,%d -> %s,%d\n" let link =
(Item.to_string i) hi (Item.to_string j) hj Printf.sprintf "%s,%d -> %s,%d\n"
in ItemMap.iter print p (Item.to_string i) hi (Item.to_string j) hj
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end end

100
Partition3.ml
View File

@ -5,7 +5,6 @@ module Make (Item: Partition.Item) =
struct struct
type item = Item.t type item = Item.t
type repr = item (** Class representatives *)
let equal i j = Item.compare i j = 0 let equal i j = Item.compare i j = 0
@ -28,59 +27,68 @@ module Make (Item: Partition.Item) =
let empty = ItemMap.empty let empty = ItemMap.empty
(** The function [repr] is faster than a persistent implementation (** The impure function [repr] is faster than a pure
in the worst case because, in the latter case, the cost is O(log n) implementation in the worst case because, in the latter case,
for accessing each node in the path to the root, whereas, in the the cost is O(log n) for accessing each node in the path to
former, only the access to the first node in the path incurs a cost the root, whereas, in the former, only the access to the first
of O(log n) -- the other nodes are accessed in constant time by node in the path incurs a cost of O(log n) -- the other nodes
following the [next] field of type [node]. *) are accessed in constant time by following the [next] field of
let seek (i: item) (p: partition) : node = type [node]. *)
let rec find_root node = let seek (i: item) (p: partition) : node =
if node.parent == node then node else find_root node.parent let rec find_root node =
in find_root (ItemMap.find i p) 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 repr item partition = (seek item partition).item
let is_equiv (i: item) (j: item) (p: partition) = let is_equiv (i: item) (j: item) (p: partition) : bool =
equal (repr i p) (repr j p) try equal (repr i p) (repr j p) with
Not_found -> false
let get_or_set item (p: partition) = let repr item partition =
try seek item p, p with try Some (repr item partition) with Not_found -> None
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 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 equiv (i: item) (j: item) (p: partition) : partition = let link src dst = src.parent <- dst
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 equiv (i: item) (j: item) (p: partition) : partition =
let ni,p = get_or_set i p in let ni,p = get_or_set i p in
let nj,p = get_or_set j p in let nj,p = get_or_set j p in
let hi,hj = ni.height, nj.height in let hi,hj = ni.height, nj.height in
let () = let () =
if not (equal ni.item nj.item) if not (equal ni.item nj.item)
then if hi = hj || equal ni.item i then if hi > hj
then (link ni nj; nj.height <- max hj (hi+1)) then link nj ni
else if hi < hj then link ni nj else (link ni nj; nj.height <- max hj (hi+1))
else link nj ni in p
in p
(* Printing *) 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
let print p = (* Printing *)
let print (p: partition) =
let buffer = Buffer.create 80 in
let print _ node = let print _ node =
Printf.printf "%s,%d -> %s,%d\n" let link =
(Item.to_string node.item) node.height Printf.sprintf "%s,%d -> %s,%d\n"
(Item.to_string node.parent.item) node.parent.height (Item.to_string node.item) node.height
in ItemMap.iter print p (Item.to_string node.parent.item) node.parent.height
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end end

35
PartitionMain.ml
View File

@ -9,22 +9,25 @@ module Test (Part: Partition.S with type item = Int.t) =
struct struct
open Part open Part
let () = empty let () =
|> equiv 4 3 empty
|> equiv 3 8 |> equiv 4 3
|> equiv 6 5 |> equiv 3 8
|> equiv 9 4 |> equiv 6 5
|> equiv 2 1 |> equiv 9 4
|> equiv 8 9 |> equiv 2 1
|> equiv 5 0 |> equiv 8 9
|> equiv 7 2 |> equiv 5 0
|> equiv 6 1 |> equiv 7 2
|> equiv 1 0 |> equiv 6 1
|> equiv 6 7 |> equiv 1 0
|> equiv 8 0 |> equiv 6 7
|> equiv 7 7 |> equiv 8 0
|> equiv 10 10 |> equiv 7 7
|> print |> equiv 10 10
|> print
|> Buffer.contents
|> print_string
end end