Tcl Library Source Code

Check-in [c261a6a0ea]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Re-integrating kbk's disjoint-set work
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: c261a6a0eae8b4d4740ac1e3eef52efb18738c909db1fc3df8c2c1af667c8d7c
User & Date: hypnotoad 2018-12-08 15:53:42
References
2019-03-02
05:06 Closed ticket [94e3466513]: Bad performance of struct::disjointset plus 7 other changes artifact: 30a063bcbf user: aku
Context
2018-12-08
15:56
Pulling the new wcswidth addition for textutil check-in: e4891a5c1d user: hypnotoad tags: trunk
15:53
Re-integrating kbk's disjoint-set work check-in: c261a6a0ea user: hypnotoad tags: trunk
2018-07-22
11:38
Add a package for trigonometric functions that use angles in degrees and additional trigonometric and hyperbolic functions, including their inverses. check-in: 7538200f88 user: arjenmarkus tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/struct/disjointset.man.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
94
95
96
97
98
99
100
















101
102
103
104
105
106
107
108
109
110
111
112





113
114
115
116
117







118
119
120
121
122
123




124
125
126
127
128
129
130
131
132
133
134
135





136
137
138
139
140
141
142
143
144
145
146






147
148

149
150
151































152
153
154
155
156
157
158
159
160
[manpage_begin struct::disjointset n 1.0]
[keywords {disjoint set}]
[keywords {equivalence class}]
[keywords find]
[keywords {merge find}]
[keywords partition]
[keywords {partitioned set}]
[keywords union]
[moddesc   {Tcl Data Structures}]
[titledesc {Disjoint set data structure}]
[category  {Data structures}]
[require Tcl 8.4]
[require struct::disjointset [opt 1.0]]
[description]
[para]

This package provides [term {disjoint sets}]. An alternative name for
this kind of structure is [term {merge-find}].

[para]
................................................................................
[call [arg disjointsetName] [arg option] [opt [arg {arg arg ...}]]]

The [cmd option] and the [arg arg]s determine the exact behavior of
the command. The following commands are possible for disjointset
objects:

[list_end]

















[call [arg disjointsetName] [method add-partition] [arg elements]]

Creates a new partition in specified disjoint set, and fills it with
the values found in the set of [arg elements]. The command maintains
the integrity of the disjoint set, i.e. it verifies that none of the
[arg elements] are already part of the disjoint set and throws an
error otherwise.

[para]

The result of the command is the empty string.






[call [arg disjointsetName] [method partitions]]

Returns the set of partitions the named disjoint set currently
consists of.








[call [arg disjointsetName] [method num-partitions]]

Returns the number of partitions the named disjoint set currently
consists of.





[call [arg disjointsetName] [method equal] [arg a] [arg b]]

Determines if the two elements [arg a] and [arg b] of the disjoint set
belong to the same partition. The result of the method is a boolean
value, [const True] if the two elements are contained in the same
partition, and [const False] otherwise.

[para]

An error will be thrown if either [arg a] or [arg b] are not elements
of the disjoint set.






[call [arg disjointsetName] [method merge] [arg a] [arg b]]

Determines the partitions the elements [arg a] and [arg b] are
contained in and merges them into a single partition.  If the two
elements were already contained in the same partition nothing will
change.

[para]

The result of the method is the empty string.







[call [arg disjointsetName] [method find] [arg e]]


Returns the partition of the disjoint set which contains the element
[arg e].
































[call [arg disjointsetName] [method destroy]]

Destroys the disjoint set object and all associated memory.

[list_end]

[vset CATEGORY {struct :: disjointset}]
[include ../doctools2base/include/feedback.inc]
[manpage_end]
>
|










|
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>
>
>




|
>
>
>
>
>
>
>






>
>
>
>












>
>
>
>
>











>
>
>
>
>
>


>
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
[vset VERSION 1.1]
[manpage_begin struct::disjointset n [vset VERSION]]
[keywords {disjoint set}]
[keywords {equivalence class}]
[keywords find]
[keywords {merge find}]
[keywords partition]
[keywords {partitioned set}]
[keywords union]
[moddesc   {Tcl Data Structures}]
[titledesc {Disjoint set data structure}]
[category  {Data structures}]
[require Tcl 8.6]
[require struct::disjointset [opt [vset VERSION]]]
[description]
[para]

This package provides [term {disjoint sets}]. An alternative name for
this kind of structure is [term {merge-find}].

[para]
................................................................................
[call [arg disjointsetName] [arg option] [opt [arg {arg arg ...}]]]

The [cmd option] and the [arg arg]s determine the exact behavior of
the command. The following commands are possible for disjointset
objects:

[list_end]

[call [arg disjointsetName] [method add-element] [arg item]]

Creates a new partition in the specified disjoint set, and fills it
with the single item [arg item].  The command maintains
the integrity of the disjoint set, i.e. it verifies that none of the
[arg elements] are already part of the disjoint set and throws an
error otherwise.

[para]

The result of this method is the empty string.

[para]

This method runs in constant time.

[call [arg disjointsetName] [method add-partition] [arg elements]]

Creates a new partition in specified disjoint set, and fills it with
the values found in the set of [arg elements]. The command maintains
the integrity of the disjoint set, i.e. it verifies that none of the
[arg elements] are already part of the disjoint set and throws an
error otherwise.

[para]

The result of the command is the empty string.

[para]

This method runs in time proportional to the size of [arg elements]].


[call [arg disjointsetName] [method partitions]]

Returns the set of partitions the named disjoint set currently
consists of. The form of the result is a list of lists; the inner
lists contain the elements of the partitions.

[para]

This method runs in time O(N*alpha(N)),
where N is the number of elements in the disjoint set and alpha
is the inverse Ackermann function.

[call [arg disjointsetName] [method num-partitions]]

Returns the number of partitions the named disjoint set currently
consists of.

[para]

This method runs in constant time.

[call [arg disjointsetName] [method equal] [arg a] [arg b]]

Determines if the two elements [arg a] and [arg b] of the disjoint set
belong to the same partition. The result of the method is a boolean
value, [const True] if the two elements are contained in the same
partition, and [const False] otherwise.

[para]

An error will be thrown if either [arg a] or [arg b] are not elements
of the disjoint set.

[para]

This method runs in amortized time O(alpha(N)), where N is the number of
elements in the larger partition and alpha is the inverse Ackermann function.

[call [arg disjointsetName] [method merge] [arg a] [arg b]]

Determines the partitions the elements [arg a] and [arg b] are
contained in and merges them into a single partition.  If the two
elements were already contained in the same partition nothing will
change.

[para]

The result of the method is the empty string.

[para]

This method runs in amortized time O(alpha(N)), where N is the number of
items in the larger of the partitions being merged. The worst case time
is O(N).

[call [arg disjointsetName] [method find] [arg e]]

Returns a list of the members of the partition of the disjoint set
which contains the element
[arg e].

[para]

This method runs in O(N*alpha(N)) time, where N is the total number of
items in the disjoint set and alpha is the inverse Ackermann function,
See [method find-exemplar] for a faster method, if all that is needed
is a unique identifier for the partition, rather than an enumeration
of all its elements.

[call [arg disjointsetName] [method exemplars]]

Returns a list containing an exemplar of each partition in the disjoint
set. The exemplar is a member of the partition, chosen arbitrarily.

[para]

This method runs in O(N*alpha(N)) time, where N is the total number of items
in the disjoint set and alpha is the inverse Ackermann function.

[call [arg disjointsetName] [method find-exemplar] [arg e]]

Returns the exemplar of the partition of the disjoint set containing
the element [arg e].  Throws an error if [arg e] is not found in the
disjoint set.  The exemplar is an arbitrarily chosen member of the partition.
The only operation that will change the exemplar of any partition is
[method merge].

[para]

This method runs in O(alpha(N)) time, where N is the number of items in
the partition containing E, and alpha is the inverse Ackermann function.

[call [arg disjointsetName] [method destroy]]

Destroys the disjoint set object and all associated memory.

[list_end]

[vset CATEGORY {struct :: disjointset}]
[include ../doctools2base/include/feedback.inc]
[manpage_end]

Changes to modules/struct/disjointset.tcl.

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340





























341
342
343
344

# disjointset.tcl --
#
#  Implementation of a Disjoint Set for Tcl.
#
# Copyright (c) Google Summer of Code 2008 Alejandro Eduardo Cruz Paz
# Copyright (c) 2008 Andreas Kupries (API redesign and simplification)













package require Tcl 8.2
package require struct::set

# Initialize the disjointset structure namespace. Note that any
# missing parent namespace (::struct) will be automatically created as
# well.
namespace eval ::struct::disjointset {
    # Counter for naming disjoint sets without a given name
    variable counter 0

    # Only export one command, the one used to instantiate a new
    # disjoint set
    namespace export disjointset
}

# ::struct::disjointset::disjointset --
#
#	Create a new disjoint set with a given name; if no name is
#	given, use disjointsetX, where X is a number.
#
# Arguments:
#	name	Optional name of the disjoint set; if not specified, generate one.
#
# Results:
#	name	Name of the disjoint set created

proc ::struct::disjointset::disjointset {args} {
    variable counter

    # Derived from the constructor of struct::queue, see file
    # "queue_tcl.tcl". Create name of not specified.
    switch -exact -- [llength [info level 0]] {
	1 {
	    # Missing name, generate one.
	    incr counter
	    set name "disjointset${counter}"
	}
	2 {
	    # Standard call. New empty disjoint set.
	    set name [lindex $args 0]
	}
	default {
	    # Error.
	    return -code error \
		"wrong # args: should be \"::struct::disjointset ?name?\""
	}
    }

    # FIRST, qualify the name.
    if {![string match "::*" $name]} {
        # Get caller's namespace; append :: if not global namespace.
        set ns [uplevel 1 [list namespace current]]
        if {"::" != $ns} {
            append ns "::"
        }
        set name "$ns$name"
    }

    # Done after qualification so that we have a canonical name and
    # know exactly what we are looking for.
    if {[llength [info commands $name]]} {
	return -code error \
	    "command \"$name\" already exists, unable to create disjointset"
    }


    # This is the structure where each disjoint set will be kept. A
    # namespace containing a list/set of the partitions, and a set of
    # all elements (for quick testing of validity when adding
    # partitions.).

    namespace eval $name {
	variable partitions {} ; # Set of partitions.
	variable all        {} ; # Set of all elements.
    }

    # Create the command to manipulate the DisjointSet
    interp alias {} ::$name {} ::struct::disjointset::DisjointSetProc $name
    return $name
}

##########################
# Private functions follow

# ::struct::disjointset::DisjointSetProc --
#
#	Command that processes all disjointset object commands.
#
# Arguments:
#	name	Name of the disjointset object to manipulate.
#	cmd	Subcommand to invoke.
#	args	Arguments for subcommand.
#
# Results:
#	Varies based on command to perform

proc ::struct::disjointset::DisjointSetProc {name {cmd ""} args} {
    # Do minimal args checks here
    if { [llength [info level 0]] == 2 } {
	error "wrong # args: should be \"$name option ?arg arg ...?\""
    }

    # Derived from the struct::queue dispatcher (see queue_tcl.tcl).
    # Gets rid of the explicit list of commands. Slower in case of an
    # error, considered acceptable, as errors should not happen, or
    # only seldomly.

    set sub _$cmd
    if { ![llength [info commands ::struct::disjointset::$sub]]} {
	set optlist [lsort [info commands ::struct::disjointset::_*]]
	set xlist {}
	foreach p $optlist {
	    set p [namespace tail $p]
	    lappend xlist [string range $p 1 end]
	}
	set optlist [linsert [join $xlist ", "] "end-1" "or"]
	return -code error \
		"bad option \"$cmd\": must be $optlist"
    }

    # Run the method in the same context as the dispatcher.
    return [uplevel 1 [linsert $args 0 ::struct::disjointset::_$cmd $name]]
}

# ::struct::disjointset::_add-partition
#
#	Creates a new partition in the disjoint set structure,
#	verifying the integrity of each new insertion for previous
#	existence in the structure.
#
# Arguments:
#	name	The name of the actual disjoint set structure
#	items	A set of elements to add to the set as a new partition.
#
# Results:
#	A new partition is added to the disjoint set.  If the disjoint
#	set already included any of the elements in any of its
#	partitions an error will be thrown.

proc ::struct::disjointset::_add-partition {name items} {
    variable ${name}::partitions
    variable ${name}::all

    # Validate that one of the elements to be added are already known.
    foreach element $items {
	if {[struct::set contains $all $element]} {
	    return -code error \
		"The element \"$element\" is already known to the disjoint set $name"
	}
    }

    struct::set add all $items
    lappend partitions  $items
    return
}

# ::struct::disjointset::_partitions
#
#	Retrieves the set of partitions the disjoint set consists of.
#
# Arguments:
#	name	The name of the disjoint set.
#
# Results:
#	A set of the partitions contained in the disjoint set.
#	If the disjoint set has no partitions the returned set
#       will be empty.

proc ::struct::disjointset::_partitions {name} {
    variable ${name}::partitions
    return $partitions
}

# ::struct::disjointset::_num-partitions
#
#	Retrieves the number of partitions the disjoint set consists of.
#
# Arguments:
#	name	The name of the disjoint set.
#
# Results:
#	The number of partitions contained in the disjoint set.

proc ::struct::disjointset::_num-partitions {name} {
    variable ${name}::partitions
    return [llength $partitions]
}

# ::struct::disjointset::_equal
#
#	Determines if the two elements belong to the same partition
#	of the disjoint set. Throws an error if either element does
#	not belong to the disjoint set at all.
#
# Arguments:
#	name	The name of the disjoint set.
#	a	The first element to be compared
#	b	The second element set to be compared
#
# Results:
#	The result of the comparison, a boolean flag.
#	True if the element are in the same partition, and False otherwise.

proc ::struct::disjointset::_equal {name a b} {
    CheckValidity $name $a
    CheckValidity $name $b
    return [expr {[FindIndex $name $a] == [FindIndex $name $b]}]
}

# ::struct::disjointset::_merge
#
#	Determines the partitions the two elements belong to and
#	merges them, if they are not the same. An error is thrown
#	if either element does not belong to the disjoint set.
#
# Arguments:
#	name	The name of the actual disjoint set structure
#	a	1st item whose partition will be merged.
#	b	2nd item whose partition will be merged.
#
# Results:
#	An empty string.

proc ::struct::disjointset::_merge {name a b} {
    CheckValidity $name $a
    CheckValidity $name $b

    set a [FindIndex $name $a]
    set b [FindIndex $name $b]

    if {$a == $b} return

    variable ${name}::partitions

    set apart [lindex $partitions $a]
    set bpart [lindex $partitions $b]

    # Remove the higher partition first, otherwise the 2nd replace
    # will access the wrong element.
    if {$b > $a} { set t $a ; set a $b ; set b $t }

    set partitions [linsert \
			[lreplace [lreplace [K $partitions [unset partitions]] \
				       $a $a] $b $b] \
			end [struct::set union $apart $bpart]]
    return
}

# ::struct::disjointset::_find
#
#	Determines and returns the partition the element belongs to.
#	Returns an empty partition if the element does not belong to
#	the disjoint set.
#
# Arguments:
#	name	The name of the disjoint set.
#	item	The element to be searched.
#
# Results:
#	Returns the partition containing the element, or an empty
#	partition if the item is not present.

proc ::struct::disjointset::_find {name item} {
    variable ${name}::all
    if {![struct::set contains $all $item]} {
	return {}
    } else {
	variable ${name}::partitions
	return [lindex $partitions [FindIndex $name $item]]
    }
}

proc ::struct::disjointset::FindIndex {name item} {
    variable ${name}::partitions
    # Check each partition directly.
    # AK XXX Future Use a nested-tree structure to make the search
    # faster

    set i 0
    foreach p $partitions {
	if {[struct::set contains $p $item]} {
	    return $i
	}
	incr i
    }
    return -1
}

# ::struct::disjointset::_destroy
#
#	Destroy the disjoint set structure and releases all memory
#	associated with it.
#
# Arguments:
#	name	The name of the actual disjoint set structure

proc ::struct::disjointset::_destroy {name} {
    namespace delete $name
    interp alias {} ::$name {}
    return
}

# ### ### ### ######### ######### #########
## Internal helper

# ::struct::disjointset::CheckValidity
#
#	Verifies if the argument element is a member of the disjoint
#	set or not. Throws an error if not.
#
# Arguments:
#	name	The name of the disjoint set
#	element	The element to look for.
#
# Results:
#	1 if element is a unary list, 0 otherwise

proc ::struct::disjointset::CheckValidity {name element} {
    variable ${name}::all
    if {![struct::set contains $all $element]} {
	return -code error \
	    "The element \"$element\" is not known to the disjoint set $name"
    }
    return
}

proc ::struct::disjointset::K { x y } { set x }

# ### ### ### ######### ######### #########
## Ready

namespace eval ::struct {
    namespace import -force disjointset::disjointset





























    namespace export disjointset
}

package provide struct::disjointset 1.0






>
>

>
>
>
>
>
>
>
>
>
>
|
<





|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|
>
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
# disjointset.tcl --
#
#  Implementation of a Disjoint Set for Tcl.
#
# Copyright (c) Google Summer of Code 2008 Alejandro Eduardo Cruz Paz
# Copyright (c) 2008 Andreas Kupries (API redesign and simplification)
# Copyright (c) 2018 by Kevin B. Kenny - reworked to a proper disjoint-sets
# data structure, added 'add-element', 'exemplars' and 'find-exemplar'.

# References
#
# - General overview
#   - https://en.wikipedia.org/wiki/Disjoint-set_data_structure
#
# - Time/Complexity proofs
#   - https://dl.acm.org/citation.cfm?doid=62.2160
#   - https://dl.acm.org/citation.cfm?doid=364099.364331
#

package require Tcl 8.6


# Initialize the disjointset structure namespace. Note that any
# missing parent namespace (::struct) will be automatically created as
# well.
namespace eval ::struct::disjointset {

    # Only export one command, the one used to instantiate a new
    # disjoint set
    namespace export disjointset
}

# class struct::disjointset::_disjointset --
#
#	Implementation of a disjoint-sets data structure

oo::class create struct::disjointset::_disjointset {

    # elements - Dictionary whose keys are all the elements in the structure,
    #            and whose values are element numbers. 
    # tree     - List indexed by element number whose members are
    #            ordered triples consisting of the element's name,
    #            the element number of the element's parent (or the element's
    #            own index if the element is a root), and the rank of
    #		 the element.
    # nParts   - Number of partitions in the structure. Maintained only
    #            so that num_partitions will work.

    variable elements tree nParts

    constructor {} {
	set elements {}
	set tree {}
	set nParts 0
    }

    # add-element --
    #
    #	Adds an element to the structure
    #
    # Parameters:
    #	item - Name of the element to add
    #
    # Results:
    #	None.
    #
    # Side effects:
    #	Element is added

    method add-element {item} {
	if {[dict exists $elements $item]} {
	    return -code error \
		-errorcode [list STRUCT DISJOINTSET DUPLICATE $item [self]] \
		"The element \"$item\" is already known to the disjoint\
            	 set [self]"
	}
	set n [llength $tree]
	dict set elements $item $n
	lappend tree [list $item $n 0]
	incr nParts
	return
    }

    # add-partition --
    #
    #	Adds a collection of new elements to a disjoint-sets structure and
    #	makes them all one partition.
    #
    # Parameters:
    #	items - List of elements to add.
    #
    # Results:
    #	None.
    #
    # Side effects:
    #	Adds all the elements, and groups them into a single partition.

    method add-partition {items} {

	# Integrity check - make sure that none of the elements have yet
	# been added

	foreach name $items {
	    if {[dict exists $elements $name]} {
		return -code error \
		    -errorcode [list STRUCT DISJOINTSET DUPLICATE \
				    $name [self]] \
		    "The element \"$name\" is already known to the disjoint\
            	     set [self]"	      	 
	    }
	}

	# Add all the elements in one go, and establish parent links for all
	# but the first
	
	set first -1
	foreach n $items {
	    set idx [llength $tree]
	    dict set elements $n $idx
	    if {$first < 0} {
		set first $idx
		set rank 1
	    } else {
		set rank 0
	    }
	    lappend tree [list $n $first $rank]
	}
	incr nParts
	return
    }

    # equal --
    #
    #	Test if two elements belong to the same partition in a disjoint-sets
    #	data structure.
    #
    # Parameters:
    #	a - Name of the first element
    #	b - Name of the second element
    #
    # Results:
    #	Returns 1 if the elements are in the same partition, and 0 otherwise.

    method equal {a b} {
	expr {[my FindNum $a] == [my FindNum $b]}
    }

    # exemplars --
    #
    #	Find one representative element for each partition in a disjoint-sets
    #	data structure.
    #
    # Results:
    #	Returns a list of element names

    method exemplars {} {
	set result {}
	set n -1
	foreach row $tree {
	    if {[lindex $row 1] == [incr n]} {
		lappend result [lindex $row 0]
	    }
	}
	return $result
    }

    # find --
    #
    #	Find the partition to which a given element belongs.
    #
    # Parameters:
    #	item - Item to find
    #
    # Results:
    #	Returns a list of the partition's members
    #
    # Notes:
    #	This operation takes time proportional to the total number of elements
    #	in the disjoint-sets structure. If a simple name of the partition
    #	is all that is required, use "find-exemplar" instead, which runs
    #	in amortized time proportional to the inverse Ackermann function of
    #	the size of the partition.

    method find {item} {
	set result {}
	# No error on a nonexistent item
	if {![dict exists $elements $item]} {
	    return {}
	}
	set pnum [my FindNum $item]
	set n -1
	foreach row $tree {
	    if {[my FindByNum [incr n]] eq $pnum} {
		lappend result [lindex $row 0]
	    }
	}
	return $result
    }

    # find-exemplar --
    #
    #	Find a representative element of the partition that contains a given
    #	element.
    #
    # parameters:
    #	item - Item to examine
    #
    # Results:
    #	Returns the exemplar
    #
    # Notes:
    #	Takes O(alpha(|P|)) amortized time, where |P| is the size of the
    #	partition, and alpha is the inverse Ackermann function

    method find-exemplar {item} {
	return [lindex $tree [my FindNum $item] 0]
    }
    
    # merge --
    #
    #	Merges the partitions that two elements are in.
    #
    # Results:
    #	None.

    method merge {a b} {
	my MergeByNum [my FindNum $a] [my FindNum $b]
    }

    # num-partitions --
    #
    #	Counts the partitions of a disjoint-sets data structure
    #
    # Results:
    #	Returns the partition count.

    method num-partitions {} {
	return $nParts
    }
    
    # partitions --
    #
    #	Enumerates the partitions of a disjoint-sets data structure
    #
    # Results:
    #	Returns a list of lists. Each list is one of the partitions
    #	in the disjoint set, and each member of the sublist is one
    #	of the elements added to the structure.

    method partitions {} {

	# Find the partition number for each element, and accumulate a
	# list per partition
	set parts {}
	dict for {element eltNo} $elements {
	    set partNo [my FindByNum $eltNo]
	    dict lappend parts $partNo $element
	}
	return [dict values $parts]
    }

    # FindNum --
    #
    #	Finds the partition number for an element.
    #
    # Parameters:
    #	item - Item to look up
    #
    # Results:
    #	Returns the partition number

    method FindNum {item} {
	if {![dict exists $elements $item]} {
	    return -code error \
		-errorcode [list STRUCT DISJOINTSET NOTFOUND $item [self]] \
		"The element \"$item\" is not known to the disjoint\
                 set [self]"	  
	}
	return [my FindByNum [dict get $elements $item]]
    }

    # FindByNum --
    #
    #	Finds the partition number for an element, given the element's
    #	index
    #
    # Parameters:
    #	idx - Index of the item to look up
    #
    # Results:
    #	Returns the partition number
    #
    # Side effects:
    #	Performs path splitting

    method FindByNum {idx} {
	while {1} {
	    set parent [lindex $tree $idx 1]
	    if {$parent == $idx} {
		return $idx
	    }
	    set prev $idx
	    set idx $parent
	    lset tree $prev 1 [lindex $tree $idx 1]
	}
    }

    # MergeByNum --
    #
    #	Merges two partitions in a disjoint-sets data structure
    #
    # Parameters:
    #	x - Index of an element in the first partition
    #	y - Index of an element in the second partition
    #
    # Results:
    #	None
    #
    # Side effects:
    #	Merges the partition of the lower rank into the one of the
    #	higher rank.

    method MergeByNum {x y} {
	set xroot [my FindByNum $x]
	set yroot [my FindByNum $y]

	if {$xroot == $yroot} {
	    # The elements are already in the same partition
	    return
	}

	incr nParts -1

	# Make xroot the taller tree
	if {[lindex $tree $xroot 2] < [lindex $tree $yroot 2]} {
	    set t $xroot; set xroot $yroot; set yroot $t
	}

	# Merge yroot into xroot
	set xrank [lindex $tree $xroot 2]
	set yrank [lindex $tree $yroot 2]
	lset tree $yroot 1 $xroot
	if {$xrank == $yrank} {
	    lset tree $xroot 2 [expr {$xrank + 1}]
	}
    }
}

# ::struct::disjointset::disjointset --
#
#	Create a new disjoint set with a given name; if no name is
#	given, use disjointsetX, where X is a number.
#
# Arguments:
#	name	Optional name of the disjoint set; if not specified, generate one.
#
# Results:
#	name	Name of the disjoint set created

proc ::struct::disjointset::disjointset {args} {

    switch -exact -- [llength $args] {
	0 {
	    return [_disjointset new]
	}
	1 {
	    # Name supplied by user
	    return [uplevel 1 [list [namespace which _disjointset] \
				   create [lindex $args 0]]]
	}
	default {
	    # Too many args
	    return -code error \
		-errorcode {TCL WRONGARGS} \
		"wrong # args: should be \"[lindex [info level 0] 0] ?name?\""
	}
    }
}

namespace eval ::struct {
    namespace import disjointset::disjointset
    namespace export disjointset
}

package provide struct::disjointset 1.1
return

Changes to modules/struct/disjointset.test.

1
2
3
4


5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
# -*- tcl -*-
# Test procedures for the disjoint set structure implementation
# Author: Alejandro Eduardo Cruz Paz
# 5 August 2008



package require tcltest
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.4
testsNeedTcltest 1.0

support {
    useAccel [useTcllibC] struct/sets.tcl struct::set
    TestAccelInit                         struct::set
}
testing {
    useLocal disjointset.tcl struct::disjointset
}

############################################################
# Helper functions
................................................................................
    return [lsort -dict $res]
}

proc djstate {ds} {
    list [canonset [$ds partitions]] [$ds num-partitions]
}

############################################################
## Iterate over all loaded implementations, activate
## them in turn, and run the tests for the active
## implementation.

TestAccelDo struct::set impl {
    # The global variable 'impl' is part of the public
    # API the testsuite (in set.testsuite) can expect
    # from the environment.

    switch -exact -- $impl {
	critcl {
	    if {[package vsatisfies [package present Tcl] 8.5]} {
		proc tmWrong {m loarg n} {
		    return [tcltest::wrongNumArgs "struct::disjointset $m" $loarg $n]
		}

		proc tmTooMany {m loarg} {
		    return [tcltest::tooManyArgs "struct::disjointset $m" $loarg]
		}

		proc Nothing {} {
		    return [tcltest::wrongNumArgs {struct::disjointset} {cmd ?arg ...?} 0]
		}
	    } else {
		proc tmWrong {m loarg n} {
		    return [tcltest::wrongNumArgs "::struct::disjointset $m" $loarg $n]
		}

		proc tmTooMany {m loarg} {
		    return [tcltest::tooManyArgs "::struct::disjointset $m" $loarg]
		}

		proc Nothing {} {
		    return [tcltest::wrongNumArgs {::struct::disjointset} {cmd ?arg ...?} 0]
		}
	    }
	}
	tcl {
	    if {[package vsatisfies [package present Tcl] 8.5]} {
		# In 8.5 head the alias itself is reported, not what it
		# resolved to.
		proc Nothing {} {
		    return [tcltest::wrongNumArgs struct::disjointset {cmd args} 0]
		}
	    } else {
		proc Nothing {} {
		    return [tcltest::wrongNumArgs {::struct::disjointset} {cmd args} 0]
		}
	    }

	    proc tmWrong {m loarg n} {
		return [tcltest::wrongNumArgs "::struct::disjointset::S_$m" $loarg $n]
	    }

	    proc tmTooMany {m loarg} {
		return [tcltest::tooManyArgs "::struct::disjointset::S_$m" $loarg]
	    }
	}
    }

    source [localPath disjointset.testsuite]
}

############################################################
TestAccelExit struct::set

testsuiteCleanup



>
>






|



<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
<

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
..
42
43
44
45
46
47
48





























































49
50




51
# -*- tcl -*-
# Test procedures for the disjoint set structure implementation
# Author: Alejandro Eduardo Cruz Paz
# 5 August 2008
# Copyright (c) 2018 by Kevin B. Kenny - reworked to a proper disjoint-sets
# data structure, added 'add-element', 'exemplars' and 'find-exemplar'.

package require tcltest
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.6
testsNeedTcltest 1.0

support {


}
testing {
    useLocal disjointset.tcl struct::disjointset
}

############################################################
# Helper functions
................................................................................
    return [lsort -dict $res]
}

proc djstate {ds} {
    list [canonset [$ds partitions]] [$ds num-partitions]
}






























































source [localPath disjointset.testsuite]





testsuiteCleanup

Changes to modules/struct/disjointset.testsuite.

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223








































































































































































# Tests for the 'disjointset' module in the 'struct' library. -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcllib
# procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2008 by Alejandro Eduardo Cruz Paz
# Copyright (c) 2008 by Andreas Kupries (extended for API changes and error conditions)



#
# RCS: @(#) $Id: disjointset.testsuite,v 1.1 2008/09/10 16:23:14 andreas_kupries Exp $

#----------------------------------------------------------------------

test disjointset-${impl}-1.0 {disjointset creation} {
    ::struct::disjointset DS
    set result [djstate DS]
    DS destroy
    set result
} {{} 0}

test disjointset-${impl}-1.1 {disjointset creation error} {
    catch {::struct::disjointset DS other} msg
    set result $msg
} {wrong # args: should be "::struct::disjointset ?name?"}

#----------------------------------------------------------------------

test disjointset-${impl}-2.0 {disjointset add-partition error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS add-partition} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_add-partition {name items} 1]

test disjointset-${impl}-2.1 {disjointset add-partition error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS add-partition x y} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_add-partition {name items}]

test disjointset-${impl}-2.2 {disjointset add-partition error, elements already known} {
    testset
    catch {DS add-partition {1}} msg
    DS destroy
    set msg
} {The element "1" is already known to the disjoint set ::DS}

test disjointset-${impl}-2.3 {disjointset add-partition, ok} {
    testset
    set result [list [DS add-partition {11 14}] [djstate DS]]
    DS destroy
    set result
} {{} {{0 {1 2 3 4} {5 6} {7 10} {8 9} {11 14}} 6}}

#----------------------------------------------------------------------

test disjointset-${impl}-3.0 {disjointset partitions error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS partitions x} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_partitions {name}]

test disjointset-${impl}-3.1 {disjointset partitions, ok} {
    testset
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4} {5 6} {7 10} {8 9}} 5}








#----------------------------------------------------------------------

test disjointset-${impl}-4.0 {disjointset equal error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS equal} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_equal {name a b} 1]

test disjointset-${impl}-4.1 {disjointset equal error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS equal x} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_equal {name a b} 2]

test disjointset-${impl}-4.2 {disjointset equal error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS equal x y z} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_equal {name a b}]

test disjointset-${impl}-4.3 {disjointset equal error, unknown elements} {
    testset
    catch {DS equal x 1} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-${impl}-4.4 {disjointset equal error, unknown elements} {
    testset
    catch {DS equal 1 x} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-${impl}-4.5 {disjointset equal ok, unequal elements} {
    testset
    set res [DS equal 1 5]
    DS destroy
    set res
} 0

test disjointset-${impl}-4.6 {disjointset equal ok, equal elements} {
    testset
    set res [DS equal 4 1]
    DS destroy
    set res
} 1

#----------------------------------------------------------------------

test disjointset-${impl}-5.0 {disjointset merge error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS merge} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_merge {name a b} 1]

test disjointset-${impl}-5.1 {disjointset merge error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS merge x} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_merge {name a b} 2]

test disjointset-${impl}-5.2 {disjointset merge error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS merge x y z} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_merge {name a b}]

test disjointset-${impl}-5.3 {disjointset merge error, unknown elements} {
    testset
    catch {DS merge x 1} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-${impl}-5.4 {disjointset merge error, unknown elements} {
    testset
    catch {DS merge 1 x} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-${impl}-5.5 {disjointset merge ok, different partitions} {
    testset
    DS merge 1 5
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4 5 6} {7 10} {8 9}} 4}

test disjointset-${impl}-5.6 {disjointset merge ok, same partition, no change} {
    testset
    DS merge 4 3
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4} {5 6} {7 10} {8 9}} 5}

#----------------------------------------------------------------------

test disjointset-${impl}-6.0 {disjointset find error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS find} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs ::struct::disjointset::_find {name item} 1]

test disjointset-${impl}-6.1 {disjointset find error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS find x y} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_find {name item}]

test disjointset-${impl}-6.2 {disjointset find, unknown element} {
    testset
    set result [DS find 11]
    DS destroy
    set result
} {}

test disjointset-${impl}-6.3 {disjointset find, known element} {
    testset
    set result [lsort -dict [DS find 3]]
    DS destroy
    set result
} {1 2 3 4}

#----------------------------------------------------------------------

test disjointset-${impl}-7.0 {disjointset num-partitions error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS num-partitions x} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs ::struct::disjointset::_num-partitions {name}]

test disjointset-${impl}-7.1 {disjointset num-partitions, ok} {
    testset
    set result [DS num-partitions]
    DS destroy
    set result
} 5

#----------------------------------------------------------------------














































































































































































|
>
>
>





|






|






|




|

|




|

|






|








|




|

|





>
>
>
>
>
>
>



|




|

|




|

|




|

|






|






|






|








|




|

|




|

|




|

|






|






|







|









|




|

|




|

|






|








|




|

|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
# Tests for the 'disjointset' module in the 'struct' library. -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcllib
# procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2008 by Alejandro Eduardo Cruz Paz
# Copyright (c) 2008 by Andreas Kupries (extended for API changes and
# error conditions)
# Copyright (c) 2018 by Kevin B. Kenny - reworked to a proper disjoint-sets
# data structure, added 'add-element', 'exemplars' and 'find-exemplar'.
#
# RCS: @(#) $Id: disjointset.testsuite,v 1.1 2008/09/10 16:23:14 andreas_kupries Exp $

#----------------------------------------------------------------------

test disjointset-1.0 {disjointset creation} {
    ::struct::disjointset DS
    set result [djstate DS]
    DS destroy
    set result
} {{} 0}

test disjointset-1.1 {disjointset creation error} {
    catch {::struct::disjointset DS other} msg
    set result $msg
} {wrong # args: should be "::struct::disjointset ?name?"}

#----------------------------------------------------------------------

test disjointset-2.0 {disjointset add-partition error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS add-partition} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS add-partition" {items} 1]

test disjointset-2.1 {disjointset add-partition error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS add-partition x y} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS add-partition" {items}]

test disjointset-2.2 {disjointset add-partition error, elements already known} {
    testset
    catch {DS add-partition {1}} msg
    DS destroy
    set msg
} {The element "1" is already known to the disjoint set ::DS}

test disjointset-2.3 {disjointset add-partition, ok} {
    testset
    set result [list [DS add-partition {11 14}] [djstate DS]]
    DS destroy
    set result
} {{} {{0 {1 2 3 4} {5 6} {7 10} {8 9} {11 14}} 6}}

#----------------------------------------------------------------------

test disjointset-3.0 {disjointset partitions error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS partitions x} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS partitions" {}]

test disjointset-3.1 {disjointset partitions, ok} {
    testset
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4} {5 6} {7 10} {8 9}} 5}

test disjointset-3.2 {disjointset partitions, empty} {
    ::struct::disjointset DS
    set result [DS partitions]
    DS destroy
    set result
} {}

#----------------------------------------------------------------------

test disjointset-4.0 {disjointset equal error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS equal} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS equal" {a b} 1]

test disjointset-4.1 {disjointset equal error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS equal x} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS equal" {a b} 2]

test disjointset-4.2 {disjointset equal error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS equal x y z} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS equal" {a b}]

test disjointset-4.3 {disjointset equal error, unknown elements} {
    testset
    catch {DS equal x 1} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-4.4 {disjointset equal error, unknown elements} {
    testset
    catch {DS equal 1 x} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-4.5 {disjointset equal ok, unequal elements} {
    testset
    set res [DS equal 1 5]
    DS destroy
    set res
} 0

test disjointset-4.6 {disjointset equal ok, equal elements} {
    testset
    set res [DS equal 4 1]
    DS destroy
    set res
} 1

#----------------------------------------------------------------------

test disjointset-5.0 {disjointset merge error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS merge} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS merge" {a b} 1]

test disjointset-5.1 {disjointset merge error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS merge x} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS merge" {a b} 2]

test disjointset-5.2 {disjointset merge error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS merge x y z} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS merge" {a b}]

test disjointset-5.3 {disjointset merge error, unknown elements} {
    testset
    catch {DS merge x 1} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-5.4 {disjointset merge error, unknown elements} {
    testset
    catch {DS merge 1 x} msg
    DS destroy
    set msg
} {The element "x" is not known to the disjoint set ::DS}

test disjointset-5.5 {disjointset merge ok, different partitions} {
    testset
    DS merge 1 5
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4 5 6} {7 10} {8 9}} 4}

test disjointset-5.6 {disjointset merge ok, same partition, no change} {
    testset
    DS merge 4 3
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4} {5 6} {7 10} {8 9}} 5}

#----------------------------------------------------------------------

test disjointset-6.0 {disjointset find error, wrong#args, missing} {
    ::struct::disjointset DS
    catch {DS find} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS find" {item} 1]

test disjointset-6.1 {disjointset find error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS find x y} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS find" {item}]

test disjointset-6.2 {disjointset find, unknown element} {
    testset
    set result [DS find 11]
    DS destroy
    set result
} {}

test disjointset-6.3 {disjointset find, known element} {
    testset
    set result [lsort -dict [DS find 3]]
    DS destroy
    set result
} {1 2 3 4}

#----------------------------------------------------------------------

test disjointset-7.0 {disjointset num-partitions error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS num-partitions x} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS num-partitions" {}]

test disjointset-7.1 {disjointset num-partitions, ok} {
    testset
    set result [DS num-partitions]
    DS destroy
    set result
} 5

#----------------------------------------------------------------------

test disjointset-8.0 {disjointset add-element error, wrongArgs, none} {
    ::struct::disjointset DS
    catch {DS add-element} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS add-element" {item} 1]

test disjointset-8.1 {disjointset add-element error, wrongArgs, too many} {
    ::struct::disjointset DS
    catch {DS add-element p q} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS add-element" {item}]

test disjointset-8.2 {disjointset add-element error, duplicate element} {
    testset
    catch {DS add-element 0} message
    DS destroy
    set message
} {The element "0" is already known to the disjoint set ::DS}

test disjointset-8.3 {disjointset add-element ok} {
    testset
    DS add-element 11
    set result [djstate DS]
    DS destroy
    set result
} {{0 {1 2 3 4} {5 6} {7 10} {8 9} 11} 6}

#----------------------------------------------------------------------

test disjointset-9.0 {disjointset find-exemplar error, wrongArgs, none} {
    ::struct::disjointset DS
    catch {DS find-exemplar} msg
    DS destroy
    set msg
} [tcltest::wrongNumArgs "DS find-exemplar" {item} 1]

test disjointset-9.1 {disjointset find-exemplar error, wrongArgs, too many} {
    ::struct::disjointset DS
    catch {DS find-exemplar p q} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS find-exemplar" {item}]

test disjointset-9.2 {disjointset find-exemplar error, not found} {
    testset
    catch {DS find-exemplar x} message
    DS destroy
    set message
} {The element "x" is not known to the disjoint set ::DS}    

test disjointset-9.3 {disjointset find-exemplar ok} {
    testset
    set result [DS find-exemplar 3]
    DS destroy
    expr {$result in {1 2 3 4}}
} {1}

#----------------------------------------------------------------------

test disjointset-10.0 {disjointset exemplars error, wrong#args, too many} {
    ::struct::disjointset DS
    catch {DS exemplars x} msg
    DS destroy
    set msg
} [tcltest::tooManyArgs "DS exemplars" {}]

test disjointset-10.1 {disjointset exemplars, ok} {
    ::struct::disjointset DS
    DS add-element 0
    set result [DS exemplars]
    DS destroy
    set result
} 0

test disjointset-10.2 {disjointset exemplars, empty} {
    ::struct::disjointset DS
    set result [DS exemplars]
    DS destroy
    set result
} {}

#----------------------------------------------------------------------

test disjointset-11.0 {disjointset merge - larger randomized set of merges} {
    struct::disjointset DS
    foreach item {a b c d e f g h i j k l m n o p q r s t u v w x y z} {
	DS add-partition [list $item]
    }
    DS merge g a
    DS merge o n
    DS merge v o
    DS merge c w
    DS merge r h
    DS merge s y
    DS merge g i
    DS merge d f
    DS merge m q
    DS merge a z
    DS merge k e
    DS merge x k
    DS merge r s
    DS merge h m
    DS merge d l
    DS merge e a
    DS merge o t
    DS merge q p
    DS merge u c
    DS merge o a
    DS merge p j
    DS merge b l
    DS merge p c
    DS merge f e
    set result [lsort [lmap x [DS partitions] {lsort $x}]]
    DS destroy
    set result
} {{a b d e f g i k l n o t v x z} {c h j m p q r s u w y}}

test disjointset-11.1 {disjointset merge - larger randomized set of merges} {
    struct::disjointset DS
    foreach item {a b c d e f g h i j k l m n o p q r s t u v w x y z} {
	DS add-partition [list $item]
    }
    DS merge g a
    DS merge o n
    DS merge v o
    DS merge c w
    DS merge r h
    DS merge s y
    DS merge g i
    DS merge d f
    DS merge m q
    DS merge a z
    DS merge k e
    DS merge x k
    DS merge r s
    DS merge h m
    DS merge d l
    DS merge e a
    DS merge o t
    DS merge q p
    DS merge u c
    DS merge o a
    DS merge p j
    DS merge b l
    DS merge p c
    DS merge f e
    set result [DS exemplars]
    DS destroy
    set trouble {}
    if {[llength $result] ne 2} {
	append trouble "\nShould be two exemplars, found $result"
    }
    lassign $result e1 e2
    set l1 {a b d e f g i k l n o t v x z}
    set l2 {c h j m p q r s u w y}
    if {!(($e1 in $l1) ^ ($e2 in $l1))} {
	append trouble "\nExactly one of $e1 and $e2\
                          should be in the first set"
    }
    if {!(($e1 in $l2) ^ ($e2 in $l2))} {
	append trouble "\nExactly one of $e1 and $e2\
                          should be in the second set"
    }
    set trouble
} {}

Changes to modules/struct/graphops.man.

1

2
3
4
5
6
7
8
9
..
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
[comment {-*- tcl -*-}]

[manpage_begin struct::graph::op n 0.11.3]
[keywords {adjacency list}]
[keywords {adjacency matrix}]
[keywords adjacent]
[keywords {approximation algorithm}]
[keywords arc]
[keywords {articulation point}]
[keywords {augmenting network}]
................................................................................
[keywords {vertex cover}]
[copyright {2008 Alejandro Paz <[email protected]>}]
[copyright {2008 (docs) Andreas Kupries <[email protected]>}]
[copyright {2009 Michal Antoniewski <[email protected]>}]
[moddesc   {Tcl Data Structures}]
[titledesc {Operation for (un)directed graph objects}]
[category  {Data structures}]
[require Tcl 8.4]
[require struct::graph::op [opt 0.11.3]]
[comment {[require struct::graph [opt 2.3]]   }]
[comment {[require struct::list  [opt 1.5]]   }]
[comment {[require struct::set   [opt 2.2.3]] }]
[description]
[para]

The package described by this document, [package struct::graph::op],
>
|







 







|
|







1
2
3
4
5
6
7
8
9
10
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
[comment {-*- tcl -*-}]
[vset VERSION 0.11.3]
[manpage_begin struct::graph::op n [vset VERSION]]
[keywords {adjacency list}]
[keywords {adjacency matrix}]
[keywords adjacent]
[keywords {approximation algorithm}]
[keywords arc]
[keywords {articulation point}]
[keywords {augmenting network}]
................................................................................
[keywords {vertex cover}]
[copyright {2008 Alejandro Paz <[email protected]>}]
[copyright {2008 (docs) Andreas Kupries <[email protected]>}]
[copyright {2009 Michal Antoniewski <[email protected]>}]
[moddesc   {Tcl Data Structures}]
[titledesc {Operation for (un)directed graph objects}]
[category  {Data structures}]
[require Tcl 8.6]
[require struct::graph::op [opt [vset VERSION]]]
[comment {[require struct::graph [opt 2.3]]   }]
[comment {[require struct::list  [opt 1.5]]   }]
[comment {[require struct::set   [opt 2.2.3]] }]
[description]
[para]

The package described by this document, [package struct::graph::op],

Changes to modules/struct/graphops.tcl.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: graphops.tcl,v 1.19 2009/09/24 19:30:10 andreas_kupries Exp $

# ### ### ### ######### ######### #########
## Requisites

package require Tcl 8.5

package require struct::disjointset ; # Used by kruskal
package require struct::prioqueue   ; # Used by kruskal, prim
package require struct::queue       ; # Used by isBipartite?, connectedComponent(Of)
package require struct::stack       ; # Used by tarjan
package require struct::graph       ; # isBridge, isCutVertex
package require struct::tree        ; # Used by BFS

# ### ### ### ######### ######### #########






|

|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: graphops.tcl,v 1.19 2009/09/24 19:30:10 andreas_kupries Exp $

# ### ### ### ######### ######### #########
## Requisites

package require Tcl 8.6

package require struct::disjointset ; # Used by kruskal -- 8.6 required
package require struct::prioqueue   ; # Used by kruskal, prim
package require struct::queue       ; # Used by isBipartite?, connectedComponent(Of)
package require struct::stack       ; # Used by tarjan
package require struct::graph       ; # isBridge, isCutVertex
package require struct::tree        ; # Used by BFS

# ### ### ### ######### ######### #########

Changes to modules/struct/graphops.test.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0

support {
    useLocal list.tcl struct::list

    useAccel [useTcllibC] struct/tree.tcl  struct::tree
    TestAccelInit                          struct::tree






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.6
testsNeedTcltest 2.0

support {
    useLocal list.tcl struct::list

    useAccel [useTcllibC] struct/tree.tcl  struct::tree
    TestAccelInit                          struct::tree

Changes to modules/struct/pkgIndex.tcl.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22





23
package ifneeded struct::queue     1.4.5 [list source [file join $dir queue.tcl]]
package ifneeded struct::stack     1.5.3 [list source [file join $dir stack.tcl]]
package ifneeded struct::tree      2.1.2 [list source [file join $dir tree.tcl]]
package ifneeded struct::matrix    2.0.3 [list source [file join $dir matrix.tcl]]
package ifneeded struct::pool      1.2.3 [list source [file join $dir pool.tcl]]
package ifneeded struct::record    1.2.1 [list source [file join $dir record.tcl]]
package ifneeded struct::set       2.2.3 [list source [file join $dir sets.tcl]]
package ifneeded struct::disjointset 1.0 [list source [file join $dir disjointset.tcl]]
package ifneeded struct::prioqueue 1.4   [list source [file join $dir prioqueue.tcl]]
package ifneeded struct::skiplist  1.3   [list source [file join $dir skiplist.tcl]]

package ifneeded struct::graph     1.2.1 [list source [file join $dir graph1.tcl]]
package ifneeded struct::tree      1.2.2 [list source [file join $dir tree1.tcl]]
package ifneeded struct::matrix    1.2.1 [list source [file join $dir matrix1.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded struct::list      1.8.3  [list source [file join $dir list.tcl]]
package ifneeded struct::graph     2.4.1  [list source [file join $dir graph.tcl]]





package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]






<










>
>
>
>
>

5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
package ifneeded struct::queue     1.4.5 [list source [file join $dir queue.tcl]]
package ifneeded struct::stack     1.5.3 [list source [file join $dir stack.tcl]]
package ifneeded struct::tree      2.1.2 [list source [file join $dir tree.tcl]]
package ifneeded struct::matrix    2.0.3 [list source [file join $dir matrix.tcl]]
package ifneeded struct::pool      1.2.3 [list source [file join $dir pool.tcl]]
package ifneeded struct::record    1.2.1 [list source [file join $dir record.tcl]]
package ifneeded struct::set       2.2.3 [list source [file join $dir sets.tcl]]

package ifneeded struct::prioqueue 1.4   [list source [file join $dir prioqueue.tcl]]
package ifneeded struct::skiplist  1.3   [list source [file join $dir skiplist.tcl]]

package ifneeded struct::graph     1.2.1 [list source [file join $dir graph1.tcl]]
package ifneeded struct::tree      1.2.2 [list source [file join $dir tree1.tcl]]
package ifneeded struct::matrix    1.2.1 [list source [file join $dir matrix1.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded struct::list      1.8.3  [list source [file join $dir list.tcl]]
package ifneeded struct::graph     2.4.1  [list source [file join $dir graph.tcl]]

if {![package vsatisfies [package provide Tcl] 8.5]} {return}

if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded struct::disjointset 1.1 [list source [file join $dir disjointset.tcl]]
package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]