Updated 2008-04-23 16:14:38 by LV

Back to SetOps, Code, 8.x

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 [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
 }