This file is indexed.

/usr/share/tcltk/tcllib1.17/struct/disjointset.tcl is in tcllib 1.17-dfsg-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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