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

20
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,18 +16,22 @@ 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 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
@ -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"
let link =
Printf.sprintf "%s -> %s\n"
(Item.to_string src) (Item.to_string dst)
in ItemMap.iter print p
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end

18
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"
let link =
Printf.sprintf "%s,%d -> %s,%d\n"
(Item.to_string i) hi (Item.to_string j) hj
in ItemMap.iter print p
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end

18
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"
let link =
Printf.sprintf "%s,%d -> %s,%d\n"
(Item.to_string i) hi (Item.to_string j) hj
in ItemMap.iter print p
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end

34
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,12 +27,13 @@ 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]. *)
(** 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
@ -41,12 +41,17 @@ module Make (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 repr item partition =
try Some (repr item partition) with Not_found -> None
let get_or_set item (p: partition) =
try seek item p, p with
Not_found -> let rec loop = {item; height=0; parent=loop}
Not_found ->
let rec loop = {item; height=0; parent=loop}
in loop, ItemMap.add item loop p
let link src dst = src.parent <- dst
@ -76,11 +81,14 @@ module Make (Item: Partition.Item) =
(* Printing *)
let print p =
let print (p: partition) =
let buffer = Buffer.create 80 in
let print _ node =
Printf.printf "%s,%d -> %s,%d\n"
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 ItemMap.iter print p
in Buffer.add_string buffer link
in ItemMap.iter print p; buffer
end

5
PartitionMain.ml
View File

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