Updated 2011-05-07 09:41:35 by dkf
# -*- tcl -*-
# test = create

set max 50

proc testA {list} {
    if {[llength $list] == 0} {
        return {}
    }
    if {[llength $list] == 1} {
        return $list
    }
    foreach e $list {
        set aa($e) .
    }
    array names aa
}

proc testB {list} {
    if {[llength $list] == 0} {
        return {}
    }
    if {[llength $list] == 1} {
        return $list
    }

    set list [lsort $list]
    set last [lindex $list 0]
    set list [lrange $list 1 end]
    set res  $last

    foreach e $list {
        if {[string compare $e $last] != 0} {
            lappend res $e
            set last    $e
        }
    }

    return $res
}

proc testC {list} {
    if {[llength $list] == 0} {
        return {}
    }
    foreach e $list {
        set $e .
    }
    unset list e
    info locals
}

proc testD {list} {
    if {[llength $list] == 0} {
        return {}
    }
    foreach $list {.} {break}
    unset list
    info locals
}

 set fa1  [open "|./2nep CR_A Ar.dat X.dat" w]
 set fb1  [open "|./2nep CR_B Br.dat X.dat" w]
 set fc1  [open "|./2nep CR_B Cr.dat X.dat" w]
 set fd1  [open "|./2nep CR_B Dr.dat X.dat" w]
 set fx   [open "|./2nep CR_X X.dat" w]

 set a0 {}

 puts stdout " ______________________________________" ; flush stdout
 puts stdout " CREA | ......A ......B ......C ......D" ; flush stdout
 puts stdout " ______________________________________" ; flush stdout

 for {set i 0} {$i <= $max} {incr i} {
    set ix [format %03d $i]

    puts stderr "   * $ix (a0) =  $a0" ; flush stderr

    set ra1  [lindex [time {testA $a0} 1000] 0]
    set rb1  [lindex [time {testB $a0} 1000] 0]
    set rc1  [lindex [time {testC $a0} 1000] 0]
    set rd1  [lindex [time {testD $a0} 1000] 0]

    puts stdout " $ix  | [format %7d $ra1] [format %7d $rb1] [format %7d $rc1] [format %7d $rd1]"

    puts $fa1 $ra1
    puts $fb1 $rb1
    puts $fc1 $rc1
    puts $fd1 $rd1
    puts $fx  $i

    lappend a0 [string range [lindex [split [expr {rand()}] .] 1] 0 4]
 }

 puts stderr "----"     ; flush stderr
 puts stdout " ______________________________________" ; flush stdout

 close $fa1
 close $fb1
 close $fc1
 close $fd1
 close $fx

See also SetOps.