1
(**************************************************************************)
5
(* Fran�ois Pottier and Yann R�gis-Gianas, INRIA Rocquencourt *)
7
(* Copyright 2005 Institut National de Recherche en Informatique et *)
8
(* en Automatique. All rights reserved. This file is distributed *)
9
(* under the terms of the Q Public License version 1.0, with the *)
10
(* change described in file LICENSE. *)
12
(**************************************************************************)
14
(* $Id: unionFind.ml,v 1.5 2005/12/01 16:20:07 regisgia Exp $ *)
16
(** This module implements a simple and efficient union/find algorithm.
17
See Robert E. Tarjan, ``Efficiency of a Good But Not Linear Set
18
Union Algorithm'', JACM 22(2), 1975. *)
20
(** The abstraction defined by this module is a set of points,
21
partitioned into equivalence classes. With each equivalence class,
22
a piece of information, of abstract type ['a], is associated; we
25
A point is implemented as a cell, whose (mutable) contents consist
26
of a single link to either information about the equivalence class,
27
or another point. Thus, points form a graph, which must be acyclic,
28
and whose connected components are the equivalence classes. In
29
every equivalence class, exactly one point has no outgoing edge,
30
and carries information about the class instead. It is the class's
31
representative element.
33
Information about a class consists of an integer weight (the number
34
of elements in the class) and of the class's descriptor. *)
45
mutable descriptor: 'a
48
(** [fresh desc] creates a fresh point and returns it. It forms an
49
equivalence class of its own, whose descriptor is [desc]. *)
51
link = Info { weight = 1; descriptor = desc }
54
(** [repr point] returns the representative element of [point]'s
55
equivalence class. It is found by starting at [point] and following
56
the links. For efficiency, the function performs path compression
61
let point'' = repr point' in
62
if point'' != point' then
64
(* [point''] is [point']'s representative element. Because we
65
just invoked [repr point'], [point'.link] must be [Link
66
point'']. We write this value into [point.link], thus
67
performing path compression. Note that this function never
68
performs memory allocation. *)
70
point.link <- point'.link;
75
(** [find point] returns the descriptor associated with [point]'s
79
(* By not calling [repr] immediately, we optimize the common cases
80
where the path starting at [point] has length 0 or 1, at the
81
expense of the general case. *)
85
| Link { link = Info info } ->
87
| Link { link = Link _ } ->
90
let rec change point v =
93
| Link { link = Info info } ->
95
| Link { link = Link _ } ->
98
(** [union point1 point2] merges the equivalence classes associated
99
with [point1] and [point2] (which must be distinct) into a single
100
class whose descriptor is that originally associated with [point2].
102
The fact that [point1] and [point2] do not originally belong to the
103
same class guarantees that we do not create a cycle in the graph.
105
The weights are used to determine whether [point1] should be made
106
to point to [point2], or vice-versa. By making the representative
107
of the smaller class point to that of the larger class, we
108
guarantee that paths remain of logarithmic length (not accounting
109
for path compression, which makes them yet smaller). *)
110
let union point1 point2 =
111
let point1 = repr point1
112
and point2 = repr point2 in
113
assert (point1 != point2);
114
match point1.link, point2.link with
115
| Info info1, Info info2 ->
116
let weight1 = info1.weight
117
and weight2 = info2.weight in
118
if weight1 >= weight2 then begin
119
point2.link <- Link point1;
120
info1.weight <- weight1 + weight2;
121
info1.descriptor <- info2.descriptor
124
point1.link <- Link point2;
125
info2.weight <- weight1 + weight2
128
assert false (* [repr] guarantees that [link] matches [Info _]. *)
130
(** [equivalent point1 point2] tells whether [point1] and [point2]
131
belong to the same equivalence class. *)
132
let equivalent point1 point2 =
133
repr point1 == repr point2
135
(** [eunion point1 point2] is identical to [union], except it does
136
nothing if [point1] and [point2] are already equivalent. *)
137
let eunion point1 point2 =
138
if not (equivalent point1 point2) then
141
(** [redundant] maps all members of an equivalence class, but one, to
143
let redundant = function
144
| { link = Link _ } ->
146
| { link = Info _ } ->
added
removed
unionFind.ml
