SetOps, Code, 8.x v2

Back to the Chart of proposed set functionality.

Back to SetOps.

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 [L1 ]

 # ---------------------------------------------
 # 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