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 $fxSee also setops.