SetOps, Code, 8.x

Back to the Chart of proposed set functionality.

See also a new proposed version SetOps, Code, 8.x v2

 # ---------------------------------------------
 # SetOps -- Set operations for Tcl
 #
 # (C) c.l.t. community, 1999
 #
 # $Id: 359,v 1.5 2003-09-18 08:00:06 jcw Exp $
 # ---------------------------------------------
 # Implementation variant for tcl 8.x and beyond.
 # Uses namespaces.
 # ---------------------------------------------


 proc ::setops::create {args} {
    if {[llength $args] == 0} {
        return {}
    }
    foreach $args {.} {break}
    unset args
    info locals
 }


 proc ::setops::contains {set element} {
    expr {[lsearch -exact $set $element] < 0 ? 0 : 1}
 }


 proc ::setops::union {args} {
    switch [llength $args] {
        0 {
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            foreach __SETA__ $args {
                if {[llength $__SETA__] > 0} {
                    foreach $__SETA__ {.} {break}
                }
            }

            unset args __SETA__
            info locals
        }
    }
 }


 proc ::setops::Intersect2 {__SETA__ __SETB__} {

    if {[llength $__SETA__] == 0} {
        return {}
    }
    if {[llength $__SETB__] == 0} {
        return {}
    }

    set __RESULT__ {}

    if {[llength $__SETA__] < [llength $__SETB__]} {
        foreach $__SETB__ {.} {break}

        foreach __ITEM__ $__SETA__ {
            if {[info exists $__ITEM__]} {
                lappend __RESULT__ $__ITEM__
            }
        }
    } else {
        foreach $__SETA__ {.} {break}

        foreach __ITEM__ $__SETB__ {
            if {[info exists $__ITEM__]} {
                lappend __RESULT__ $__ITEM__
            }
        }
    }

    return $__RESULT__
 }


 proc ::setops::intersect {args} {
    switch [llength $args] {
        0 {
            # Intersection of nothing is nothing
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            set res  [lindex $args 0]
            set args [lrange $args 1 end]

            while {($res != {}) && ([llength $args] > 0)} {
                set res  [Intersect2 $res [lindex $args 0]]
                set args [lrange $args 1 end]
            }

            return $res
        }
    }
 }


 proc ::setops::diff {__SETA__ __SETB__} {
    if {[llength $__SETA__] == 0} {
        return {}
    }
    if {[llength $__SETB__] == 0} {
        return $__SETA__
    }

    set __RESULT__ {}

    foreach $__SETB__ {.} {break}

    foreach __ITEM__ $__SETA__ {
        if {![info exists $__ITEM__]} {
            lappend __RESULT__ $__ITEM__
        }
    }

    return $__RESULT__
 }


 proc ::setops::symdiff {a b} {
    diff [union $a $b] [Intersect2 $a $b]
 }


 proc ::setops::empty {set} {
    expr {[llength $set] == 0}
 }

The above code does not work if the set elements look syntactically like array variables. For example

 setops::union {a b} {c b foo(local)}

returns

 foo a b c

The problem is use of local variables (optimization) instead of an explicit array. Neat trick but doesn't quite work. APN

Category Package