Arjen Markus (15 november 2023) I have been playing with the idea for a long time, but then I had some time to spend on it: have [expr] work on lists of data, via pure Tcl. Well, the code below is merely a proof of concept, I have no idea if it is practical or performant or what. And it will never beat compiled extensions like vectcl. But then, it is not meant to.
Just consider it a vain attempt by a long-time Tcler to bring a flavour of numerical array processing into Tcl without having to compile code. It is, partly indeed, showing off how flexible Tcl really is.
# array_expr.tcl -- # Array expressions in pure Tcl? # # lexpr -- # Evaluate an expression which contains lists of numbers # # Arguments: # expression Expression to be evaluated # # Result: # The value of the expression with the numbers filled in # one by one. In general, this will be a list of values. # # Example: # set a {1 2 3} # puts [lexpr {2*$a}] # ==> {2 4 6} # proc lexpr {expression} { # # Examine the expression: scalars and arrays # set names [regexp -inline -all {\$[A-Za-z0-9_]+} $expression] set foreachVars {} foreach name $names { set name [string range $name 1 end] upvar 1 $name __$name if { [llength [set __$name]] > 1 } { lappend foreachVars $name [set __$name] } else { set $name [set __$name] } } if { [llength $foreachVars] > 0 } { set __result {} foreach {*}$foreachVars { lappend __result [expr $expression] } return $__result } else { expr $expression } } # And test the idea ... set a {1 2 3} set b {1 0 3} set c 1 puts [lexpr {tan($a) + $b + $c}] set d 1 puts [lexpr {tan($d) + $c}]
NR - 2023-11-16 11:46:42
Just an opinion, but I find that the most boring to write in an expression in Tcl is the '$' attached to each variable, I find the idea of vectcl very interesting not to use them. In any case, thank you for this example.
arjen - 2023-11-17 07:41:30
Indeed, vectcl is a wonderful extension - the code I posted is not at all meant as an alternative. The challenge for me was whether I could do this in pure Tcl and it turned out to be much simpler than I expected. The advantage of it being pure Tcl is that you do not need to rely on the pacakge being available on your particular platform, but that is really just a small convenience.
Bocaj22 - 2023-11-22 01:45:40
Impressive. This makes me wonder if a similar approach could extend expr to handle matrix math as well, while staying in pure tcl.
zorg - 2023-12-13 19:43:32
added code to:
proc lexpr {args} { if {([llength $args] == 1)} {set expression {*}$args} else {set expression $args} if {![regexp {\$} $expression]} { set names [regexp -inline -all -nocase {[a-z_][a-z0-9_]*} $expression] set mathfunc [regsub -all {::tcl::mathfunc::} [info commands ::tcl::mathfunc::*] {}] set names [lsearch -inline -all -regexp -not $names [format {\y(%s)\y} [join $mathfunc |]]] if {[llength $names]} {set expression [regsub -all [format {\y(%s)\y} [join $names |]] $expression {$\1}]} } if {[llength [set names [regexp -inline -all -nocase {\$[a-z_][a-z0-9_]*} $expression]]]} { set names [regsub -all {\$} $names {}]; set varval_loop {} foreach name $names { upvar 1 $name __$name if {[llength [set __$name]] > 1} { lappend varval_loop $name [set __$name] } else {set $name [set __$name]} } if {[llength $varval_loop]} {foreach {*}$varval_loop {lappend __result [expr $expression]}; set __result} else {expr $expression} } else {expr $expression} }
and to test it
lexpr {tan($a) + $b + $c} lexpr {tan(a) + b + c} lexpr tan(a) + b + c lexpr tan(a)+b+c lexpr {tan($d) + $c} lexpr {tan(d) + c} lexpr tan(d) + c lexpr tan(d)+c
zorg - 2023-12-14 08:34:48
simplify by learning...
proc joinargs a {if {([llength $a] == 1)} {return {*}$a} else {return $a}} proc getvarsfromexpr expr {regexp -inline -all -nocase {\m\$?[a-z_][a-z0-9_]*\M(?!\()} $expr]} proc lexpr args { set expression [joinargs $args] set names [getvarsfromexpr $expression] if {[llength $names]} { if {![regexp {\$} $expression]} {set expression [regsub -all [format {\m(%s)\M} [join $names |]] $expression {$\1}]} set varval_loop {} foreach name $names {upvar 1 $name __$name; if {[llength [set __$name]] > 1} {lappend varval_loop $name [set __$name]} else {set $name [set __$name]}} if {[llength $varval_loop]} {foreach {*}$varval_loop {lappend __result [expr $expression]}; return $__result} } return [expr $expression] }