if false {
wdb If possible, for mathematical problems I ask maxima or wolfram alpha, then I take their output as input for expr.
This method fails if the resulting formulas contain complex numbers. The function expr doesn't calculate (yet) complex values, so all I can do is using own complex functions which are in prefix notion, such as
% complex+ {3 4} {1 5}
4 9
%But therefore, I must transform infix-notated formulae to prefix. Here it comes:
}
namespace eval infixToPrefix {
namespace export *
}
proc infixToPrefix::tokenize src {
# list tokens in $src
set result {}
set l [string length $src]
set str ""
for {set i 0} {$i < $l} {incr i} {
if {[string index $src $i] in {+ - * / ^ ( )}} then {
if {$str ne ""} then {
lappend result $str
set str ""
}
lappend result [string index $src $i]
} else {
append str [string index $src $i]
}
}
if {$str ne ""} then {
lappend result $str
}
set result
}
proc infixToPrefix::listify tokenList {
# return nested lists
set level 0
set term {}
set result {}
foreach token $tokenList {
if {$token eq "\("} then {
incr level
}
if {$level == 0} then {
if {[llength $term] > 0} then {
lappend result [listify [lrange $term 1 end-1]]
set term {}
}
lappend result $token
} else {
lappend term $token
}
if {$token eq "\)"} then {
incr level -1
}
}
if {[llength $term] > 0} then {
lappend result [listify [lrange $term 1 end-1]]
}
set result
}
proc infixToPrefix::extractFunctions lst {
# group function calls (precedence 1)
set funcs [info functions]
lappend funcs -
if {[llength $lst] < 2} then {
# echo length [llength $lst] -- $lst
if {[llength [lindex $lst 0]] < 2} then {
set lst
} else {
list [groupByPrecedence [lindex $lst 0]]
}
} elseif {[lindex $lst 0] in $funcs} then {
# leading function name found
set lst1 [extractFunctions [lrange $lst 1 end]]
list [list [lindex $lst 0] [lindex $lst1 0]] {*}[lrange $lst1 1 end]
} else {
# not a function
list\
[groupByPrecedence [lindex $lst 0]]\
[lindex $lst 1]\
{*}[groupByPrecedence [lrange $lst 2 end]]
}
}
proc infixToPrefix::groupByOp {lst op} {
# group equal operators
set idx [lsearch $lst [string map [list * \\*] $op]]
if {$idx < 0} then {
# no occurrence of $op in $lst
set lst
} else {
set start [expr $idx-1]
set result [lrange $lst 0 [expr {$start-1}]]
set l [llength $lst]
for {set i $idx} {$i < $l} {incr i 2} {
if {[lindex $lst $i] ne $op} then break
}
set end [expr {$i-1}]
lappend result\
[lrange $lst $start $end]\
{*}[groupByOp [lrange $lst [expr {$end+1}] end] $op]
}
}
proc infixToPrefix::groupByOps {lst args} {
# group subsequently by operators
foreach op $args {
set lst [groupByOp $lst $op]
}
set lst
}
proc infixToPrefix::groupByPrecedence lst {
# group by precedence: function-name, ^, /, *, -, +
if {[llength $lst] < 2} then {
set result $lst
} else {
set result [groupByOps [extractFunctions $lst] ^ / * - +]
}
if {[llength $result] == 1} then {
lindex $result 0
} else {
set result
}
}
proc infixToPrefix::grpToPrefix grp {
# put infix-operators to front
if {[llength $grp] == 1} then {
set grp
} elseif {[llength $grp] == 2} then {
list [lindex $grp 0] [grpToPrefix [lindex $grp 1]]
} else {
lassign $grp term op
lappend result $op [grpToPrefix $term]
foreach {op term} [lrange $grp 1 end] {
lappend result [grpToPrefix $term]
}
set result
}
}
proc infixToPrefix::simplifyExpr prf {
# splice nested terms with equal operator
if {[llength $prf] < 2} then {
set prf
} else {
set op [lindex $prf 0]
lappend result $op
foreach expr [lrange $prf 1 end] {
set expr1 [simplifyExpr $expr]
if {$op in {+ *} && [lindex $expr1 0] eq $op} then {
lappend result {*}[lrange $expr1 1 end]
} else {
lappend result $expr1
}
}
set result
}
}
if false {
The final function transforms braces to brackets and maxima-specific terms to own-specific ones.
}
proc infixToPrefix::infixToPrefix term {
# return lambda-expr to be apply'd
set tok [tokenize $term]
set lis [listify $tok]
set grp [groupByPrecedence $lis]
set prf [grpToPrefix $grp]
set exp [simplifyExpr $prf]
set trns [string map\
[list \{ \[ \} \]\
%i "{0 1}"\
^ complex** sqrt complexSqrt\
/ complex/ * complex*\
- complex- + complex+]\
$exp]
regsub -all { ([a-zA-Z]+)} $trns { $\1}
}
namespace import infixToPrefix::infixToPrefix
if false {
Example:
% infixToPrefix "a * x ^ b + c" complex+ [complex* $a [complex** $x $b]] $c % }