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} *)
(** 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]. *)
val repr : item -> partition -> item
(** The value of the call [repr 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 repr : item -> partition -> item option
(** 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
partition [p] on a buffer, 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].*)
val is_equiv : item -> item -> partition -> bool
end

24
Partition0.ml
View File

@ -4,7 +4,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
@ -17,19 +16,23 @@ module Make (Item: Partition.Item) =
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 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 rj, p = get_or_set j p in
if equal ri rj then p else ItemMap.add ri rj p
@ -38,10 +41,13 @@ 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

20
Partition1.ml
View File

@ -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,14 +22,18 @@ 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 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 repr item partition =
try Some (repr item partition) with Not_found -> None
let get_or_set (i: item) (p: partition) =
try seek i p, p with
@ -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

20
Partition2.ml
View File

@ -5,7 +5,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
@ -55,15 +54,19 @@ 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 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 repr item partition =
try Some (repr item partition) with Not_found -> None
let get_or_set (i: item) (p: partition) =
try seek i p, p with
@ -101,6 +104,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 +112,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

100
Partition3.ml
View File

@ -5,7 +5,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
@ -28,59 +27,68 @@ module Make (Item: Partition.Item) =
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)
(** 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 item partition = (seek item partition).item
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 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 repr item partition =
try Some (repr item partition) with Not_found -> None
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 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 link src dst = src.parent <- dst
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 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
(* 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 =
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
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

35
PartitionMain.ml
View File

@ -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