MS: I did not feel sure about changing SetOps, Code, 8.x directly ...Here is a different implementation of the set operations - I did not time it yet (intersect will certainly be slower). The notable differences to the previous are:
- There are no forbidden names for set elements. The previous version had problems with elements called '__SETA__', '__SETB__', '__RESULT__', '__ITEM__' or 'args'.
- The symmetric difference is redefined in terms of union and difference
- Uses 'unset -nocomplain'; is this valid for all 8.x ?
AK: Note that there is a C implementation available [1]
# ---------------------------------------------
# SetOps -- Set operations for Tcl
#
# (C) c.l.t. community, 1999
# (C) TclWiki community, 2001
#
# $Id: 1763,v 1.1 2002-06-21 03:28:48 jcw Exp $
# ---------------------------------------------
# Implementation variant for tcl 8.x and beyond.
# Uses namespaces and 'unset -nocomplain'
# ---------------------------------------------
# NOTE: [set][array names] in the {} array is faster than
# [set][info locals] for local vars; it is however slower
# for [info exists] or [unset] ...
namespace eval ::setops {
namespace export {[a-z]*}
}
proc ::setops::create {args} {
cleanup $args
}
proc ::setops::cleanup {A} {
# unset A to avoid collisions
foreach [lindex [list $A [unset A]] 0] {.} {break}
info locals
}
proc ::setops::union {args} {
switch [llength $args] {
0 {return {}}
1 {return [lindex $args 0]}
}
foreach setX $args {
foreach x $setX {set ($x) {}}
}
array names {}
}
proc ::setops::diff {A B} {
if {[llength $A] == 0} {
return {}
}
if {[llength $B] == 0} {
return $A
}
# get the variable B out of the way, avoid collisions
# prepare for "pure list optimisation"
set ::setops::tmp [lreplace $B -1 -1 unset -nocomplain]
unset B
# unset A early: no local variables left
foreach [lindex [list $A [unset A]] 0] {.} {break}
eval $::setops::tmp
info locals
}
proc ::setops::contains {set element} {
expr {[lsearch -exact $set $element] < 0 ? 0 : 1}
}
proc ::setops::symdiff {A B} {
union [diff $A $B] [diff $B $A]
}
proc ::setops::empty {set} {
expr {[llength $set] == 0}
}
proc ::setops::intersect {args} {
set res [lindex $args 0]
foreach set [lrange $args 1 end] {
if {[llength $res] && [llength $set]} {
set res [Intersect $res $set]
} else {
break
}
}
set res
}
proc ::setops::Intersect {A B} {
# This is slower than local vars, but more robust
if {[llength $B] > [llength $A]} {
set res $A
set A $B
set B $res
}
set res {}
foreach x $A {set ($x) {}}
foreach x $B {
if {[info exists ($x)]} {
lappend res $x
}
}
set res
}