1#----------------------------------------------*-TCL-*------------ 2# 3# units.tcl 4# 5# The units package provides a conversion facility from a variety of 6# scientific and engineering shorthand notations into floating point 7# numbers. 8# 9# Robert W. Techentin 10# November 1, 2000 11# Copyright (C) Mayo Foundation. All Rights Reserved. 12# 13#----------------------------------------------------------------- 14package provide units 2.1 15 16package require Tcl 8.1 17 18namespace eval ::units { 19 20 namespace export new 21 namespace export convert 22 namespace export reduce 23 24 variable UnitTable 25 variable PrefixTable 26} 27 28 29#----------------------------------------------------------------- 30# 31# ::units::new -- 32# 33# Add a new unit to the units table. The new unit is defined 34# in terms of its baseUnits. If baseUnits is "-primitive", 35# then it is assumed to be some magical new kind of quantity. 36# Otherwise, it must reduce to units already defined. 37# 38#----------------------------------------------------------------- 39proc ::units::new { args } { 40 41 variable UnitTable 42 variable UnitList 43 44 # Check number of arguments 45 switch [llength $args] { 46 2 { 47 set name [lindex $args 0] 48 set baseUnits [lindex $args 1] 49 } 50 default { 51 # issue same error as C extension 52 error "Wrong # args. units::new name baseUnits " 53 } 54 } 55 56 # check for duplicates 57 if { [info exists UnitTable($name)] } { 58 error "unit '$name' is already defined" 59 } 60 61 # check for valid characters 62 if { [regexp {[^a-zA-Z]} $name] } { 63 error "non-alphabetic characters in unit name '$name'" 64 } 65 66 # Compute reduced units 67 if { [catch {::units::reduce $baseUnits} reducedUnits] } { 68 error "'$baseUnits' cannot be reduced to primitive units" 69 } 70 71 # add the unit, but don't return a value 72 set UnitTable($name) $reducedUnits 73 lappend UnitList $name $reducedUnits 74 return 75} 76 77#----------------------------------------------------------------- 78# 79# ::units::convert -- 80# 81# Convert a value to the target units. 82# 83# If units are specified for the value, then they must 84# be compatible with the target units. (i.e., you can 85# convert "newtons" to "kg-m/s^2", but not to "sieverts". 86# 87# Arguments: 88# value A value can be a floating point number, either with or 89# without units. 90# targetUnits A units string which may also include a scale factor. 91# 92# Results: 93# The return value is a scaled floating point number. 94# 95#----------------------------------------------------------------- 96 97proc ::units::convert { args } { 98 99 # Check number of arguments 100 switch [llength $args] { 101 2 { 102 set value [lindex $args 0] 103 # make sure it isn't octal (bug 758702) 104 set value [string trimleft $value "0"] 105 set targetUnits [lindex $args 1] 106 } 107 default { 108 # issue same error as C extension 109 error "Wrong # args. units::convert value targetUnits " 110 } 111 } 112 113 # Reduce each of value and target 114 # to primitive units 115 set reducedValue [::units::reduce $value] 116 set reducedTarget [::units::reduce $targetUnits] 117 118 # If the value has units, it must be compatible with 119 # the target. (If it is unitless, then compatibility 120 # is not required.) 121 if { [llength $reducedValue] > 1} { 122 if {[lrange $reducedValue 1 end]!=[lrange $reducedTarget 1 end]} { 123 error "'$value' and '$targetUnits' have incompatible units" 124 } 125 } 126 127 # Compute and return scaled value 128 expr {[lindex $reducedValue 0] / [lindex $reducedTarget 0]} 129} 130 131 132#----------------------------------------------------------------- 133# 134# ::units::reduce -- 135# 136# Reduce a string of numbers, prefixes, units, exponents into a 137# single multiplicitive factor and sorted list of primitive units. 138# For example, the unit string for "newton", which is "m-kg/s^2" 139# would reduce to the list {1000.0 gram meter / second second} 140# 141# Unit String Syntax 142# 143# This procedure defines a valid unit string that may 144# be reduced to primitive units, so it is reasonable to 145# document valid unit string syntax here. 146# 147# A unit string consists of an optional scale factor followed 148# by zero or more subunit strings. The scale factor must be 149# a valid floating point number. 150# 151# Subunits are separated by unit separator characters, which are 152# " ", "-", "*", and "/". It is not necessary to separate 153# the leading scale factor from the rest of the subunits. 154# 155# The forward slash seperator "/" indicates that following 156# subunits are in the denominator. There can be at most 157# one "/" separator. 158# 159# Subunits can be floating point scale factors, but they 160# must be surrounded by valid separators. 161# 162# Subunits can be valid units or abbreviations from the 163# UnitsTable. They may include a prefix from the PrefixTable. 164# They may include a plural suffix "s" or "es". They may 165# also include a power string "^", followed by an integer, 166# after the unit name (or plural suffix, if there is one.) 167# 168# Examples of valid unit strings: "meter", "/s", "kg-m/s^2", 169# "30second" "30 second", "30 seconds" "200*meter/20.5*second" 170# 171# Arguments: 172# unitString string of units characters 173# 174# Results: 175# The return value is a list, the first element of which 176# is the multiplicitive factor, and the remaining elements are 177# sorted reduced primitive units, possibly including the "/" 178# operator, which separates the numerator from the denominator. 179#----------------------------------------------------------------- 180# 181 182proc ::units::reduce { args } { 183 184 # Check number of arguments 185 switch [llength $args] { 186 1 { 187 set unitString [lindex $args 0] 188 } 189 default { 190 # issue same error as C extension 191 error "Wrong # args. units::reduce unitString " 192 } 193 } 194 195 # check for primitive unit - may already be reduced 196 # This gets excercised by new units 197 if { "$unitString" == "-primitive" } { 198 return $unitString 199 } 200 201 # trim leading and trailing white space 202 set unitString [string trim $unitString] 203 204 # Check cache of unitStrings 205 if { [info exists ::units::cache($unitString)] } { 206 return $::units::cache($unitString) 207 } 208 209 # Verify syntax of unit string 210 # It may contain, at most, one "/" 211 if { [regexp {/.*/} $unitString] } { 212 error "invalid unit string '$unitString': only one '/' allowed" 213 } 214 # It may contain only letters, digits, the powerstring ("^"), 215 # decimal points, and separators 216 if { [regexp {[^a-zA-Z0-9. \t*^/+-]} $unitString] } { 217 error "invalid characters in unit string '$unitString'" 218 } 219 220 # Check for leading scale factor 221 # If the leading characters are in floating point 222 # format, then extract and save them (including any 223 # minus signs) before handling subunit separators. 224 # This is based on a regexp from Roland B. Roberts which 225 # allows leading +/-, digits, decimals, and exponents. 226 regexp {(^[-+]?(?:[0-9]+\.?[0-9]*|\.[0-9]+)(?:[eE][-+]?[0-9]+)?)?(.*)} \ 227 $unitString matchvar scaleFactor subunits 228 # Ensure that scale factor is a nice floating point number 229 if { "$scaleFactor" == "" } { 230 set scaleFactor 1.0 231 } else { 232 set scaleFactor [expr {double($scaleFactor)}] 233 } 234 235 # replace all separators with spaces. 236 regsub -all {[\t\-\*]} $subunits " " subunits 237 # add spaces around "/" character. 238 regsub {/} $subunits " / " subunits 239 240 # The unitString is now essentially a well structured list 241 # of subunits, which may be processed as a list, and it 242 # may be necessary to process it recursively, without 243 # performing the string syntax checks again. But check 244 # for errors. 245 if { [catch {ReduceList $scaleFactor $subunits} result] } { 246 error "$result in '$unitString'" 247 } 248 249 # Store the reduced unit in a cache, so future lookups 250 # are much quicker. 251 set ::units::cache($unitString) $result 252} 253 254 255#----------------------------------------------------------------- 256# 257# ::units::ReduceList -- 258# 259# Reduce a list of subunits to primitive units and a single 260# scale factor. 261# 262# Arguments: 263# factor A scale factor, which is multiplied and divided 264# by subunit prefix values and constants. 265# unitString A unit string which is syntactically correct 266# and includes only space separators. This 267# string can be treated as a Tcl list. 268# 269# Results: 270# A valid unit string list, consisting of a single floating 271# point factor, followed by sorted primitive units. If the 272# forward slash separator "/" is included, then each of the 273# numerator and denominator is sorted, and common units have 274# been cancelled. 275# 276#----------------------------------------------------------------- 277# 278proc ::units::ReduceList { factor unitString } { 279 280 variable UnitList 281 variable UnitTable 282 variable PrefixTable 283 284 # process each subunit in turn, starting in the numerator 285 # 286 # Note that we're going to use a boolean flag to switch 287 # between numerator and denominator if we encounter a "/". 288 # This same style is used for processing recursively 289 # reduced subunits 290 set numerflag 1 291 set numerator [list] 292 set denominator [list] 293 foreach subunit $unitString { 294 295 # Check for "/" 296 if { "$subunit" == "/" } { 297 set numerflag [expr {$numerflag?0:1}] 298 continue 299 } 300 301 # Constant factor 302 if { [string is double -strict $subunit] } { 303 if { $subunit == 0.0 } { 304 error "illegal zero factor" 305 } else { 306 if { $numerflag } { 307 set factor [expr {$factor * $subunit}] 308 } else { 309 set factor [expr {$factor / $subunit}] 310 } 311 continue 312 } 313 } 314 315 # Check for power string (e.g. "s^2") 316 # We could use regexp to match and split in one operation, 317 # like {([^\^]*)\^(.*)} but that seems to be pretty durn 318 # slow, so we'll just using [string] operations. 319 if { [set index [string first "^" $subunit]] >= 0 } { 320 set subunitname [string range $subunit 0 [expr {$index-1}]] 321 set exponent [string range $subunit [expr {$index+1}] end] 322 if { ! [string is integer -strict $exponent] } { 323 error "invalid integer exponent" 324 } 325 # This is a good test and error message, but it won't 326 # happen, because the negative sign (hypen) has already 327 # been interpreted as a unit separator. Negative 328 # exponents will trigger the 'invalid integer' message, 329 # because there is no exponent. :-) 330 if { $exponent < 1 } { 331 error "invalid non-positive exponent" 332 } 333 } else { 334 set subunitname $subunit 335 set exponent 1 336 } 337 338 # Check subunit name syntax 339 if { ! [string is alpha -strict $subunitname] } { 340 error "invalid non-alphabetic unit name" 341 } 342 343 # Try looking up the subunitname. 344 # 345 # Start with the unit name. But if the unit ends in "s" 346 # or "es", then we want to try shortened (singular) 347 # versions of the subunit as well. 348 set unitValue "" 349 350 set subunitmatchlist [list $subunitname] 351 if { [string range $subunitname end end] == "s" } { 352 lappend subunitmatchlist [string range $subunitname 0 end-1] 353 } 354 if { [string range $subunitname end-1 end] == "es" } { 355 lappend subunitmatchlist [string range $subunitname 0 end-2] 356 } 357 358 foreach singularunit $subunitmatchlist { 359 360 set len [string length $singularunit] 361 362 # Search the unit list in order, because we 363 # wouldn't want to accidentally match the "m" 364 # at the end of "gram" and conclude that we 365 # have "meter". 366 foreach {name value} $UnitList { 367 368 # Try to match the string starting at the 369 # at the end, just in case there is a prefix. 370 # We only have a match if both the prefix and 371 # unit name are exact matches. 372 set pos [expr {$len - [string length $name]}] 373 #set pos [expr {$len-1}] 374 if { [string range $singularunit $pos end] == $name } { 375 376 set prefix [string range $singularunit 0 [expr {$pos-1}]] 377 set matchsubunit $name 378 379 # If we have no prefix or a valid prefix, 380 # then we've got an actual match. 381 if { ("$prefix" == "") || \ 382 [info exists PrefixTable($prefix)] } { 383 # Set the unit value string 384 set unitValue $value 385 # done searching UnitList 386 break 387 } 388 } 389 # check for done 390 if { $unitValue != "" } { 391 break 392 } 393 } 394 } 395 396 # Check for not-found 397 if { "$unitValue" == "" } { 398 error "invalid unit name '$subunitname'" 399 } 400 401 # Multiply the factor by the prefix value 402 if { "$prefix" != "" } { 403 # Look up prefix value recursively, so abbreviations 404 # like "k" for "kilo" will work. Note that we 405 # don't need error checking here (as we do for 406 # unit lookup) because we have total control over 407 # the prefix table. 408 while { ! [string is double -strict $prefix] } { 409 set prefix $PrefixTable($prefix) 410 } 411 # Save prefix multiple in factor 412 set multiple [expr {pow($prefix,$exponent)}] 413 if { $numerflag } { 414 set factor [expr {$factor * $multiple}] 415 } else { 416 set factor [expr {$factor / $multiple}] 417 } 418 } 419 420 421 # Is this a primitive subunit? 422 if { "$unitValue" == "-primitive" } { 423 # just append the matching subunit to the result 424 # (this doesn't have prefix or trailing "s") 425 for {set i 0} {$i<$exponent} {incr i} { 426 if { $numerflag } { 427 lappend numerator $matchsubunit 428 } else { 429 lappend denominator $matchsubunit 430 } 431 } 432 } else { 433 # Recursively reduce, unless it is in the cache 434 if { [info exists ::units::cache($unitValue)] } { 435 set reducedUnit $::units::cache($unitValue) 436 } else { 437 set reducedUnit [::units::reduce $unitValue] 438 set ::units::cache($unitValue) $reducedUnit 439 } 440 441 # Include multiple factor from reduced unit 442 set multiple [expr {pow([lindex $reducedUnit 0],$exponent)}] 443 if { $numerflag } { 444 set factor [expr {$factor * $multiple}] 445 } else { 446 set factor [expr {$factor / $multiple}] 447 } 448 449 # Add primitive subunits to numerator/denominator 450 # 451 # Note that we're use a nested boolean flag to switch 452 # between numerator and denominator. Subunits in 453 # the numerator of the unitString are processed 454 # normally, but subunits in the denominator of 455 # unitString must be inverted. 456 set numerflag2 $numerflag 457 foreach u [lrange $reducedUnit 1 end] { 458 if { "$u" == "/" } { 459 set numerflag2 [expr {$numerflag2?0:1}] 460 continue 461 } 462 # Append the reduced units "exponent" times 463 for {set i 0} {$i<$exponent} {incr i} { 464 if { $numerflag2 } { 465 lappend numerator $u 466 } else { 467 lappend denominator $u 468 } 469 } 470 } 471 } 472 } 473 474 # Sort both numerator and denominator 475 set numerator [lsort $numerator] 476 set denominator [lsort $denominator] 477 478 # Cancel any duplicate units. 479 # Foreach and for loops don't work well for this. 480 # (We keep changing list length). 481 set i 0 482 while {$i < [llength $numerator]} { 483 set u [lindex $numerator $i] 484 set index [lsearch $denominator $u] 485 if { $index >= 0 } { 486 set numerator [lreplace $numerator $i $i] 487 set denominator [lreplace $denominator $index $index] 488 } else { 489 incr i 490 } 491 } 492 493 # Now we've got numerator, denominator, and factors. 494 # Assemble the result into a single list. 495 if { [llength $denominator] > 0 } { 496 set result [eval list $factor $numerator "/" $denominator] 497 } else { 498 set result [eval list $factor $numerator] 499 } 500 501 # Now return the result 502 return $result 503} 504 505 506#----------------------------------------------------------------- 507# 508# Initialize namespace variables 509# 510#----------------------------------------------------------------- 511namespace eval ::units { 512 513 set PrefixList { 514 yotta 1e24 515 zetta 1e21 516 exa 1e18 517 peta 1e15 518 tera 1e12 519 giga 1e9 520 mega 1e6 521 kilo 1e3 522 hecto 1e2 523 deka 1e1 524 deca 1e1 525 deci 1e-1 526 centi 1e-2 527 milli 1e-3 528 micro 1e-6 529 nano 1e-9 530 pico 1e-12 531 femto 1e-15 532 atto 1e-18 533 zepto 1e-21 534 yocto 1e-24 535 Y yotta 536 Z zetta 537 E exa 538 P peta 539 T tera 540 G giga 541 M mega 542 k kilo 543 h hecto 544 da deka 545 d deci 546 c centi 547 m milli 548 u micro 549 n nano 550 p pico 551 f femto 552 a atto 553 z zepto 554 y yocto 555 } 556 557 array set PrefixTable $PrefixList 558 559 560 set SIunits { 561 meter -primitive 562 gram -primitive 563 second -primitive 564 ampere -primitive 565 kelvin -primitive 566 mole -primitive 567 candela -primitive 568 radian meter/meter 569 steradian meter^2/meter^2 570 hertz /second 571 newton meter-kilogram/second^2 572 pascal kilogram/meter-second^2 573 joule meter^2-kilogram/second^2 574 watt meter^2-kilogram/second^3 575 coulomb second-ampere 576 volt meter^2-kilogram/second^3-ampere 577 farad second^4-ampere^2/meter^2-kilogram 578 ohm meter^2-kilogram/second^3-ampere^2 579 siemens second^3-ampere^2/meter^2-kilogram 580 weber meter^2-kilogram/second^2-ampere 581 tesla kilogram/second^2-ampere 582 henry meter^2-kilogram/second^2-ampere^2 583 lumen candela-steradian 584 lux candela-steradian/meter^2 585 becquerel /second 586 gray meter^2/second^2 587 sievert meter^2/second^2 588 } 589 set SIabbrevs { 590 m meter 591 g gram 592 s second 593 A ampere 594 K kelvin 595 mol mole 596 cd candela 597 rad radian 598 sr steradian 599 Hz hertz 600 N newton 601 Pa pascal 602 J joule 603 W watt 604 C coulomb 605 V volt 606 F farad 607 S siemens 608 Wb weber 609 T tesla 610 H henry 611 lm lumen 612 lx lux 613 Bq becquerel 614 Gy gray 615 Sv sievert 616 } 617 618 # Selected non-SI units from Appendix B of the Guide for 619 # the use of the International System of Units 620 set nonSIunits { 621 angstrom 1.0E-10meter 622 astronomicalUnit 1.495979E11meter 623 atmosphere 1.01325E5pascal 624 bar 1.0E5pascal 625 calorie 4.1868joule 626 curie 3.7E10becquerel 627 day 8.64E4second 628 degree 1.745329E-2radian 629 erg 1.0E-7joule 630 faraday 9.648531coulomb 631 fermi 1.0E-15meter 632 foot 3.048E-1meter 633 gauss 1.0E-4tesla 634 gilbert 7.957747E-1ampere 635 grain 6.479891E-5kilogram 636 hectare 1.0E4meter^2 637 hour 3.6E3second 638 inch 2.54E-2meter 639 lightYear 9.46073E15meter 640 liter 1.0E-3meter^3 641 maxwell 1.0E-8weber 642 mho 1.0siemens 643 micron 1.0E-6meter 644 mil 2.54E-5meter 645 mile 1.609344E3meter 646 minute 6.0E1second 647 parsec 3.085E16meter 648 pica 4.233333E-3meter 649 pound 4.535924E-1kilogram 650 revolution 6.283185radian 651 revolutionPerMinute 1.047198E-1radian/second 652 yard 9.144E-1meter 653 year 3.1536E7second 654 } 655 set nonSIabbrevs { 656 AU astronomicalUnit 657 ft foot 658 gr grain 659 ha hectare 660 h hour 661 in inch 662 L liter 663 Mx maxwell 664 mi mile 665 min minute 666 pc parsec 667 lb pound 668 r revolution 669 rpm revolutionPerMinute 670 yd yard 671 } 672 673 foreach {name value} $SIunits { 674 lappend UnitList $name $value 675 set UnitTable($name) $value 676 } 677 foreach {name value} $nonSIunits { 678 lappend UnitList $name $value 679 set UnitTable($name) $value 680 } 681 foreach {name value} $SIabbrevs { 682 lappend UnitList $name $value 683 set UnitTable($name) $value 684 } 685 foreach {name value} $nonSIabbrevs { 686 lappend UnitList $name $value 687 set UnitTable($name) $value 688 } 689 690} 691