# -*- tcl -*-
# test = intersection + differences set max 50 proc testA {a b} { if {[llength $a] == 0} { return [list {} {} $b] } if {[llength $b] == 0} { return [list {} $a {}] } set res_is {} set res_ab {} set res_ba {} 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, add to intersection. lappend res_is [lindex $a 0] 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 B-A. lappend res_ba [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 A-B. lappend res_ab [lindex $a 0] set a [lrange $a 1 end] } if {[llength $a] == 0} { foreach e $b { lappend res_ba $e } return [list $res_is $res_ab $res_ba] } if {[llength $b] == 0} { foreach e $a { lappend res_ab $e } return [list $res_is $res_ab $res_ba] } } return [list $res_is $res_ab $res_ba] } proc testC {a b} { if {[llength $a] == 0} { return [list {} {} $b] } if {[llength $b] == 0} { return [list {} $a {}] } set res_i {} set res_ab {} set res_ba {} foreach e $b { set ba($e) . } foreach e $a { set aa($e) . } foreach e $a { if {![info exists ba($e)]} { lappend res_ab $e } else { lappend res_i $e } } foreach e $b { if {![info exists aa($e)]} { lappend res_ba $e } else { lappend res_i $e } } list $res_i $res_ab $res_ba } 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 testB {a b} { list [Intersect2 $a $b] [diff $a $b] [diff $b $a] } # IS_NE -> a, b random, unsorted, intersection almost always empty # IS_EQ -> a = b, random set fa1 [open "|./2nep IS_A_NE Ar.dat X.dat" w] set fa2 [open "|./2nep IS_A_EQ Ae0.dat X.dat" w] set fb1 [open "|./2nep IS_B_NE Br.dat X.dat" w] set fb2 [open "|./2nep IS_B_EQ Be0.dat X.dat" w] set fc1 [open "|./2nep IS_C_NE Cr.dat X.dat" w] set fc2 [open "|./2nep IS_C_EQ Ce0.dat X.dat" w] set fx [open "|./2nep IS_X X.dat" w] set a0 {} set b0 {} puts stdout " ______________________________" ; flush stdout puts stdout " ISECT| ......A ......B ......C" ; 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] puts stdout " ______________________________" ; flush stdout puts stdout " $ix NE [format %7d $ra1] [format %7d $rb1] [format %7d $rc1]" puts stdout " $ix EQ [format %7d $ra2] [format %7d $rb2] [format %7d $rc2]" puts $fa1 $ra1 puts $fa2 $ra2 puts $fb1 $rb1 puts $fb2 $rb2 puts $fc1 $rc1 puts $fc2 $rc2 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 $fx