unitmath 5 km / 20 minand should return 15 km/h. This involves both string and list manipulations, and finally a simple calculation, and returns the result with the matching unit. For more usage examples, see the "test suite" which comes before unitmath itself, as a hint that one should design tests before starting development:
proc unitmath'test {} {
set fail 0
foreach {cmd expected} {
{unitmath 5 km / 20 min} {15 km/h}
{unitmath {2 m * 3 m}} {6 m2}
{unitmath 60.00$ / 50.00$} 1.2
{unitmath 2 m+60 cm} {2.6 m}
{unitmath 1 h / 4} {15 min}
{unitmath 2 ft / 3} {8 in}
{unitmath 2 ft 6 in * 3 ft} {7.5 sq.ft}
{unitmath 2m * 3m * 4m} {24 m3}
} {
catch $cmd res ;# errors can't stop this test suite...
puts [list $cmd $res]
if [string compare $res $expected] {
puts "[incr fail]. expected: $expected"
}
}
if !$fail {puts "passed all tests"}
}
proc unitmath args {
array set convert {
m,cm 100 m,mm 1000 h,min 60 km/min,km/h 60 ft,in 12
}
if {[llength $args]==1} {set args [lindex $args 0]}
regsub -all {([0-9])([a-zA-Z$])} "{$args}" {\1 \2} uexpr
foreach op {+ - * /} {
set uexpr [string map [list $op "\} $op \{"] $uexpr]
} ;#-- grouping numbers and their units together
set numUnits ""; set denUnits ""
set multiplying 0
set expr ""
set where numUnits ;# "pointer" to where new units go
#puts [list uexpr: $uexpr]
foreach part $uexpr {
switch -- $part {
"+" - "-" {append expr $part}
"*" {append expr ")*("; set multiplying 1}
"/" {append expr ")/("; set where denUnits}
default {
foreach {value unit} [join $part] {;#break
#puts [list part: $part value: $value unit: $unit]
if $multiplying {
lappend $where $unit
} else {
set targetUnit [set $where]
if {$targetUnit != ""} {
if {$unit != $targetUnit} {
set f $convert($targetUnit,$unit)
set value [expr {$value * 1.0 / $f}]
}
} else {set $where $unit}
}
append expr + $value
}
}
}
}
if {$numUnits == $denUnits} {
set units "" ;# cancel out ratios, e.g. $/$
} else {
set units [join $numUnits *]
if {[llength $denUnits]} {append units / [join $denUnits *]}
}
puts [list expr: $expr]
set res [expr 1.0*($expr)] ;# avoid integer division
if {$res<1} {
set convs [array names convert $units,*]
if {[llength $convs]} {
set f [lindex $convs 0] ;# simply pick first factor
set res [expr $res * $convert($f)]
regexp $units,(.+) $f -> units
} ;# try to "upgrade" small results
}
string trim [string map {
".0 " " " m*m*m m3 m*m m2 ft*ft sq.ft
} "$res $units"]
}
if {[file tail [info script]]==[file tail $argv0]} unitmath'test2002-11-09 - Here's code to handle unit prefixes as used in decimal systems, e.g. m and k in
0.001 m = 1 mm (millimeter) 1000 m = 1 km (kilometer)These prefixes, which typically involve scaling by 10 to the n-th power, where n is a multiple of 3, are applicable to all units in the MKSA system (meter - kilogram - second - Ampere) and their derivations, e.g. Hz (Hertz, = 1/sec). Normalizing unit-dimensioned values is a simple operation on paper, but to implement it in Tcl involves some interesting leaps between types:
- first we have a number (integer or float)
- normalize to scientific representation with [format %e]
- extract mantissa/exponent and their signs from the resulting string
- look up a suitable unit in a pair list
- finally adjust the amount (mantissa) and compose a result string
proc unitprefix {amount unit} {
set sci [format %e $amount]
regexp {(.+)e(.)0*(.+)} $sci -> mantissa esign exponent
set exponent $esign$exponent ;# avoid leading zeroes
foreach {prefix order} {
u -6 m -3 "" 0 k 3 M 6 G 9 T 12
} {
if {$exponent <= $order+2} break
}
return "[expr {$amount/pow(10,$order)}] $prefix$unit"
}The usual name for this is Dimensional Analysis.

