SetOps, Intersection, Timing Script

# -*- tcl -*-

 # test = intersection

 set max 50


 proc testA {a b} {
    if {[llength $a] == 0} {
        return {}
    }
    if {[llength $b] == 0} {
        return {}
    }

    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 intersection
            lappend res [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.
            set b [lrange $b 1 end]
        } else {
            # A < B, remove A, we are beyond the element.
            set a [lrange $a 1 end]
        }
        if {[llength $a] == 0} {
            return $res
        }
        if {[llength $b] == 0} {
            return $res
        }
    }

    return $res
 }


 proc testB {a b} {
    if {[llength $a] == 0} {
        return {}
    }
    if {[llength $b] == 0} {
        return {}
    }

    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 {}
    }
    if {[llength $b] == 0} {
        return {}
    }

    set res {}

    if {[llength $a] < [llength $b]} {
        foreach e $b {
            set check($e) .
        }
        foreach e $a {
            if {[info exists check($e)]} {
                lappend res $e
            }
        }
    } else {
        foreach e $a {
            set check($e) .
        }
        foreach e $b {
            if {[info exists check($e)]} {
                lappend res $e
            }
        }
    }

    return $res
 }


 proc testD {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
 }


 # 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_B_NE Cr.dat   X.dat" w]
 set fc2  [open "|./2nep IS_B_EQ Ce0.dat  X.dat" w]
 set fd1  [open "|./2nep IS_B_NE Dr.dat   X.dat" w]
 set fd2  [open "|./2nep IS_B_EQ De0.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 ......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