On the 2006-04-21 revision 4 of this page, it was overwritten by something partially French. It's unclear whether that was equivalent (although malformed) content or not, but French-speaking readers might want to take a look (use Revisions at the bottom of this page). ''[EKB] To me, it looks like the script was passed through a translation program. It's amusingly literal.''

 # -*- tcl -*-
 # test = union

 set max 50


 proc testA {args} {
    switch [llength $args] {
        0 {
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            foreach set $args {
                foreach e $set {
                    set tmp($e) .
                }
            }
            return [array names tmp]
        }
    }
 }


 proc testB {args} {
    switch [llength $args] {
        0 {
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            set tmp {}
            foreach set $args {
                foreach e $set {
                    lappend tmp $e
                }
            }
            # remove duplicates --
            # sort and scan. shortcut in case of empty or
            # single-element result.

            if {[llength $tmp] < 2} {
                return $tmp
            }

            set tmp  [lsort  $tmp]
            set last [lindex $tmp 0]
            set tmp  [lrange $tmp 1 end]
            set res  $last

            foreach e $tmp {
                if {[string compare $e $last] != 0} {
                    lappend res $e
                    set last    $e
                }
            }

            return $res
        }
    }
 }


 proc testC {args} {
    switch [llength $args] {
        0 {
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            set tmp {}
            foreach set $args {
                foreach e $set {
                    lappend tmp $e
                }
            }
            # -W- remove duplicates --
            # hash out. shortcut in case of empty or
            # single-element result.

            if {[llength $tmp] < 2} {
                return $tmp
            }

            foreach e $tmp {
                set tmpa($e) .
            }

            return [array names tmpa]
        }
    }
 }


 proc testD {args} {
    switch [llength $args] {
        0 {
            return {}
        }
        1 {
            return [lindex $args 0]
        }
        default {
            foreach set $args {
                if {[llength $set] > 0} {
                    foreach $set {.} {break}
                }
            }

            unset args set
            info locals
        }
    }
 }


 # UN_NE -> a, b   random, unsorted, intersection almost always empty
 # UN_EQ -> a = b, random

 set fa1  [open "|./2nep UN_A_NE Ar.dat   X.dat" w]
 set fa2  [open "|./2nep UN_A_EQ Ae0.dat  X.dat" w]

 set fb1  [open "|./2nep UN_B_NE Br.dat   X.dat" w]
 set fb2  [open "|./2nep UN_B_EQ Be0.dat  X.dat" w]

 set fc1  [open "|./2nep UN_B_NE Cr.dat   X.dat" w]
 set fc2  [open "|./2nep UN_B_EQ Ce0.dat  X.dat" w]

 set fd1  [open "|./2nep UN_B_NE Dr.dat   X.dat" w]
 set fd2  [open "|./2nep UN_B_EQ De0.dat  X.dat" w]

 set fx   [open "|./2nep UN_X     X.dat" w]

 set a0 {}
 set b0 {}

 puts stdout " ______________________________________" ; flush stdout
 puts stdout " UNION| ......A ......B ......C ......D" ; flush stdout

 for {set i 0} {$i <= $max} {incr i} {
    set ix [format %03d $i]

    puts stderr "   * $ix (a0) =  $a0" ; flush stderr
    puts stderr "   * $ix (b0) =  $b0" ; flush stderr

    set ra1  [lindex [time {testA $a0 $b0} 1000] 0]
    set ra2  [lindex [time {testA $a0 $a0} 1000] 0]

    set rb1  [lindex [time {testB $a0 $b0} 1000] 0]
    set rb2  [lindex [time {testB $a0 $a0} 1000] 0]

    set rc1  [lindex [time {testC $a0 $b0} 1000] 0]
    set rc2  [lindex [time {testC $a0 $a0} 1000] 0]

    set rd1  [lindex [time {testD $a0 $b0} 1000] 0]
    set rd2  [lindex [time {testD $a0 $a0} 1000] 0]

    puts stdout " ______________________________________" ; flush stdout
    puts stdout " $ix NE [format %7d $ra1] [format %7d $rb1] [format %7d $rc1] [format %7d $rd1]"
    puts stdout " $ix EQ [format %7d $ra2] [format %7d $rb2] [format %7d $rc2] [format %7d $rd2]"

    puts $fa1 $ra1
    puts $fa2 $ra2

    puts $fb1 $rb1
    puts $fb2 $rb2

    puts $fc1 $rc1
    puts $fc2 $rc2

    puts $fd1 $rd1
    puts $fd2 $rd2

    puts $fx  $i

    lappend a0 [string range [lindex [split [expr {rand()}] .] 1] 0 4]
    lappend b0 [string range [lindex [split [expr {rand()}] .] 1] 0 4]
 }

 puts stderr "----"     ; flush stderr
 puts stdout " ______________________________________" ; flush stdout

 close $fa1
 close $fa2

 close $fb1
 close $fb2

 close $fc1
 close $fc2

 close $fd1
 close $fd2

 close $fx

----
See also [setops].
----
[Category Performance]