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'test
2002-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.