# -*- tcl -*-
# test = symdiff
set max 50
proc testA {a b} {
if {[llength $a] == 0} {
return $b
}
if {[llength $b] == 0} {
return $a
}
set res {}
set a [lsort $a]
set b [lsort $b]
while {1} {
# Store lindex/0,1 in var, access later faster ?
set n [string compare [lindex $a 0] [lindex $b 0]]
if {$n == 0} {
# A = B => element in both, so not in sym. difference
set a [lrange $a 1 end]
set b [lrange $b 1 end]
} elseif {$n > 0} {
# A > B, remove B, we are beyond the element.
# This element in B is part of the result too.
lappend res [lindex $b 0]
set b [lrange $b 1 end]
} else {
# A < B, remove A, we are beyond the element.
# This element in A is part of the result too.
lappend res [lindex $a 0]
set a [lrange $a 1 end]
}
if {[llength $a] == 0} {
foreach e $b {
lappend res $e
}
return $res
}
if {[llength $b] == 0} {
foreach e $a {
lappend res $e
}
return $res
}
}
return $res
}
proc testB {a b} {
if {[llength $a] == 0} {
return $b
}
if {[llength $b] == 0} {
return $a
}
set res {}
foreach e $a {
set aa($e) .
}
foreach e $b {
set ba($e) .
}
foreach e $a {
if {[info exists aa($e)] != [info exists ba($e)]} {
lappend res $e
}
}
foreach e $b {
if {[info exists aa($e)] != [info exists ba($e)]} {
lappend res $e
}
}
return $res
}
proc testC {a b} {
if {[llength $a] == 0} {
return $b
}
if {[llength $b] == 0} {
return $a
}
set res {}
foreach e $a {
set aa($e) .
}
foreach e $b {
set ba($e) .
}
foreach e $a {
if {![info exists ba($e)]} {
lappend res $e
}
}
foreach e $b {
if {![info exists aa($e)]} {
lappend res $e
}
}
return $res
}
proc union {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
}
}
}
proc Intersect2 {a b} {
if {[llength $a] == 0} {
return {}
}
if {[llength $b] == 0} {
return {}
}
set res {}
if {[llength $a] < [llength $b]} {
foreach $b {.} {break}
foreach e $a {
if {[info exists $e]} {
lappend res $e
}
}
} else {
foreach $a {.} {break}
foreach e $b {
if {[info exists $e]} {
lappend res $e
}
}
}
return $res
}
proc diff {a b} {
if {[llength $a] == 0} {
return {}
}
if {[llength $b] == 0} {
return $a
}
set res {}
foreach $b {.} {break}
foreach e $a {
if {![info exists $e]} {
lappend res $e
}
}
return $res
}
proc testD {a b} {
diff [union $a $b] [Intersect2 $a $b]
}
# SD_NE -> a, b random, unsorted, intersection almost always empty
# SD_EQ -> a = b, random
set fa1 [open "|./2nep SD_A_NE Ar.dat X.dat" w]
set fa2 [open "|./2nep SD_A_EQ Ae0.dat X.dat" w]
set fb1 [open "|./2nep SD_B_NE Br.dat X.dat" w]
set fb2 [open "|./2nep SD_B_EQ Be0.dat X.dat" w]
set fc1 [open "|./2nep SD_B_NE Cr.dat X.dat" w]
set fc2 [open "|./2nep SD_B_EQ Ce0.dat X.dat" w]
set fd1 [open "|./2nep SD_B_NE Dr.dat X.dat" w]
set fd2 [open "|./2nep SD_B_EQ De0.dat X.dat" w]
set fx [open "|./2nep SD_X X.dat" w]
set a0 {}
set b0 {}
puts stdout " ______________________________________" ; flush stdout
puts stdout " SYMDF| ......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.
