Arjen Markus (19 april 2006) In languages like Fortran 90/95 and MATLAB, you can use expressions on arrays which are treated element-wise. For instance:
real, dimension(10) :: a, b real :: c a = 2.0 * b + c
is evaluated in a way equivalent to:
do i = 1,10
a(i) = 2.0 * b(i) + c
enddo(to use a Fortran 90/95 example)
I thought it might be nice to have this ability in Tcl as well ...
For the sake of a simple example, I used the "all" function from Fortran:
which can be viewed as an array itself.
The script below turns the expression given as the argument to [all] into a (hidden) procedure that utilises [foreach] to evaluate the expression for each list element in turn.
Note:
I used the [catch] command to make memoisation trivial, but [catch] is fairly expensive.
# listexpr.tcl --
# Using [expr] on lists:
# if u and v are lists, then [all {$u > $v}]
# returns 1 if all elements of u are larger than the corresponding
# elements of v and 0 if there is at least one element for which
# the condition does not hold.
#
# makeListProc --
# Create a procedure that handles the list expression
# Arguments:
# expr The expression to be examined element by element
# body The body of the procedure (minus the preliminaries)
# Result:
# Name of the generated procedure
# Note:
# The body argument may contain the substrings EXPR and VARS
# - these are replaced by the expr argument and by the generated
# list of variables for use in the foreach construct.
#
# Limitations:
# The expression should not contain subcommands, that is:
# {$u > [splice $v 1]} would not be parsed properly.
#
proc makeListProc {expr body} {
set vars [lsort -unique [regexp -all -inline {\$[a-zA-Z0-9_]+} $expr]]
set eachlist ""
set decls ""
foreach name $vars {
set vname [string range $name 1 end]
if { [uplevel 2 "llength $name"] > 1 } {
append eachlist "$vname \$_$vname "
append decls "upvar 2 $vname _$vname\n"
} else {
append decls "upvar 2 $vname $vname\n"
}
}
set body [string map [list VARS $eachlist EXPR $expr] $body]
proc $expr {} $decls$body
return $expr
}
# all --
# Check if all elements in the lists referred to in an expression
# comply to that expression
# Arguments:
# expr Expression to be checked
# Result:
# 1 if all elements comply, 0 otherwise. If the lists are
# empty, return 1 too.
#
proc all {expr} {
if { [catch $expr result] } {
makeListProc $expr \
{
set result 1
foreach VARS {
if { !(EXPR) } {
set result 0
break
}
}
return $result }
set result [$expr]
}
return $result
}
proc all_simple {expr} {
upvar 1 u u
if { [llength $u] > 1 } {
return [$expr]
}
}
# main --
# Simple test case
#
set u {1 2 3 4}
set v {0 1 2 3}
puts "u > v? [all {$u>$v}]"
set u {2 3 4 1}
puts "u > v? [all {$u>$v}]"
# Measure the time ...
#
proc check {u v} {
set result 0
foreach u1 $u v1 $v {
if { ! ($u1 > $v1) } {
set result 0
break
}
}
return $result
}
puts "Do some timing ..."
set dummy [check $u $v]
foreach len {3 10 30 100 300 1000 3000 10000} \
times {10000 3000 1000 300 100 30 10 3 } {
set u {}
set v {}
for {set i 0} {$i < $len} {incr i} {
lappend u [expr {2+rand()}]
lappend v [expr {rand()}]
}
puts "Length = $len: [time {all {$u>$v}} $times] - [time {check $u $v} $times]"
}
# Note: all_simple breaks if we do this:
# set u 0
# all_simple {$u>$v}
#
puts "How about a combination of lists and scalar variables?"
set u 0.1
puts "v > 0.1? [all {$v>$u}]"
set u -0.1
puts "v > -0.1? [all {$v>$u}]"The output from the script:
u > v? 1 u > v? 0 Do some timing ... Length = 3: 86 microseconds per iteration - 3 microseconds per iteration Length = 10: 88 microseconds per iteration - 5 microseconds per iteration Length = 30: 95 microseconds per iteration - 12 microseconds per iteration Length = 100: 118 microseconds per iteration - 36 microseconds per iteration Length = 300: 182 microseconds per iteration - 103 microseconds per iteration Length = 1000: 408 microseconds per iteration - 337 microseconds per iteration Length = 3000: 1080 microseconds per iteration - 1065 microseconds per iteration Length = 10000: 3465 microseconds per iteration - 3538 microseconds per iteration How about a combination of lists and scalar variables? v > 0.1? 0 v > -0.1? 1
See also Vector arithmetics
... and also fold, filter, map, and zip which are higher-order functions for invoking operations on every member of a list in this way. For instance, the "all" function above can be rewritten as:
proc invoke {cmd args} { uplevel #0 $cmd $args }
proc zipWith {op xs ys} {
set ret [list]
foreach x $xs y $ys { lappend ret [invoke $op $x $y] }
return $ret
}
proc foldl {op id xs} {
foreach x $xs { set id [invoke $op $id $x] }
return $id
}
proc > {a b} { expr {$a > $b} }
proc and {a b} { expr {$a && $b} }
proc all {op xs ys} { foldl and 1 [zipWith $op $xs $ys] }
# Then, e.g.:
all > $u $v