SetOps, Intersect3, Timing Script

# -*- 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
Category Performance