Richard Suchenwirth 1999-08-02 - Here's another weekend fun project: Set operations don't sound like that much fun, but see for yourself.
AK See also the Chart of proposed set functionality.
AK See also Tcllib's module struct, package struct::set.
It all starts with an encouraging error message:
proc Set {A {args}} {
set usage {usage: Set $A op $B, where A and B are setlists and
op is one of: ==, !=, >, >=, <=, <, has (return truth values 0/1),
or: -, &, | (return setlists: difference, intersection, union)
You can force a list L to a setlist S by: set S [Set $L]
}
set res {}
if {$args==""} {return [Set $A | {}]}
foreach {op B} $args {break}
switch -- $op {
== {set res [expr ![string compare [lsort $A] [lsort $B]]]}
!= {set res [expr [string compare [lsort $A] [lsort $B]]]}
<= {set res 1; foreach i $A {if ![Set $B has $i] {return 0}}}
< {set res [expr {[Set $A <= $B] && [Set $B - $A] != {}}]}
>= {set res [Set $B <= $A]}
> {set res [Set $B < $A]}
has {set res [expr {[lsearch -exact $A $B]>=0}]}
- {foreach i $A {if ![Set $B has $i] {lappend res $i}}}
& {foreach i $A {if [Set $B has $i] {lappend res $i}}}
| {foreach i "$A $B" {if {![Set $res has $i]} {lappend res $i}}}
default {error $usage}
}
set res
}This set (usage examples are interspersed in the source, more see below) is sufficient for most things one could do with sets, but adding elements to a set is clumsy (set S [Set $S | $e]) and may get slow. Thus I added the following, which use lappend and an upvar'ed set name:
proc Set+ {_S e} {
# Add an element to a list - more efficient than set S [Set $S | $e]
upvar $_S S
if ![Set $S has $e] {lappend S $e}
return $S
}
proc Set- {_S e} {
# Remove an element from a list == set S [Set $S - $e]
# provided for symmetry only
upvar $_S S
set S [Set $S - $e]
}Here's a timing tester that I run after each modification:
proc test {what {how_often 100}} {
puts "----- start test"
foreach {i expected} $what {
set us [time {catch {eval $i} res} $how_often]
if {$res!=$expected} {
append res "<<<<<<<<<< expected: $expected"
} else {append res ", ok."}
puts "{$i} -> $res in [lindex $us 0] us"
}
puts "----- end test"
}
#------------ if 0 for production code, if 1 for debugging
if 1 {
test {
{set S [Set {red white blue red} | {}]} {red white blue}
{set S [Set {red white blue red}]} {red white blue}
{Set $S == {white blue red}} 1
{Set {red white} != $S} 1
{Set {red white} <= $S} 1
{Set $S < $S} 0
{Set $S > $S} 0
{Set {red white} >= $S} 0
{Set $S has "white" as element} 1
{Set $S has "white" inside} {testing test error message, don't worry.}
{Set $S has "green"} 0
{Set $S | {black red yellow}} {red white blue black yellow}
{Set $S & {black red yellow}} red
{Set $S - {black red yellow}} {white blue}
{Set+ S green} {red white blue green}
{Set- S blue} {red white green}
{Set an error} {an error message}
} 500
}On this occasion, I discovered another sugar (see Salt and Sugar): As the number of arguments is not constant, I use args to collect them and foreach..break to extract op and B. The break means the rest is ignored, so additional arguments work as much as comments do, but allow writing
if [Set $S has "white" as element] {...
while [Set $S has "white" inside] {...As before, I'm not quite sure how to use this fascinating potential. One of these days, I'll write the page Is Tcl Different!.