Back to [SetOps, Code, 8.x] Back to the [Chart of proposed set functionality]. ---- [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 [http://www.purl.org/NET/akupries/soft/setops/index.html] ---- # --------------------------------------------- # 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 } ---- !!!!!! %| [Category Package] |% !!!!!!