Numerical array processing in pure Tcl

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:

  • allow expressions without dollars
  • allow braces to be omitted
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]
}
Category Toys
Updated 2023-12-14 08:34:48