1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module type PersistentArray = sig
type 'a t
val empty : 'a t
val get : 'a t -> int -> 'a option
val set : 'a t -> int -> 'a -> 'a t
val push : 'a t -> 'a -> 'a t
val pp : 'a Fmt.t -> 'a t Fmt.t
end
module Make (A : PersistentArray) : sig
type t
type elt = int
val empty : unit -> t
val find : t -> elt -> elt
val union : t -> elt -> elt -> elt * t
val pp : t Fmt.t
end = struct
type t = { rank : int A.t; mutable parent : int A.t }
type elt = int
let empty () = { rank = A.empty; parent = A.empty }
let rec find_aux f i =
let fi = A.get f i |> Option.value ~default:i in
if fi == i then (f, i)
else
let (f, r) = find_aux f fi in
let f = A.set f i r in
(f, r)
let find (h : t) (x : int) =
let (f, cx) = find_aux h.parent x in
h.parent <- f ;
cx
let union (h : t) (x : elt) (y : elt) =
let cx = find h x in
let cy = find h y in
if cx != cy then
let rx = A.get h.rank cx |> Option.value ~default:0 in
let ry = A.get h.rank cy |> Option.value ~default:0 in
if rx > ry then (cx, { h with parent = A.set h.parent cy cx })
else if rx < ry then (cy, { h with parent = A.set h.parent cx cy })
else
(cx, { rank = A.set h.rank cx (rx + 1); parent = A.set h.parent cy cx })
else (cx, h)
let pp fmtr uf = A.pp Fmt.int fmtr uf.parent
end
module Map_based = Make (struct
type 'a t = 'a Int_map.t
let empty = Int_map.empty
let get a i = Int_map.find_opt i a
let set a i v = Int_map.add i v a
let push a v = Int_map.add (Int_map.cardinal a) v a
let pp pp_v ppf a =
let pp_elt ppf (i, v) = Fmt.pf ppf "%d: %a" i pp_v v in
Fmt.pf ppf "{@[<hov>%a@]}" (Fmt.iter_bindings Int_map.iter pp_elt) a
end)