1 | # ---------------------------------------------------------------------- |
---|
2 | # COMPONENT: units - mechanism for converting numbers with units |
---|
3 | # |
---|
4 | # These routines make it easy to define a system of units, to decode |
---|
5 | # numbers with units, and convert a number from one set of units to |
---|
6 | # another. |
---|
7 | # ====================================================================== |
---|
8 | # AUTHOR: Michael McLennan, Purdue University |
---|
9 | # Copyright (c) 2004-2005 Purdue Research Foundation |
---|
10 | # |
---|
11 | # See the file "license.terms" for information on usage and |
---|
12 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
13 | # ====================================================================== |
---|
14 | package require Itcl |
---|
15 | |
---|
16 | namespace eval Rappture { # forward declaration } |
---|
17 | namespace eval Rappture::Units { # forward declaration } |
---|
18 | |
---|
19 | # ---------------------------------------------------------------------- |
---|
20 | # USAGE: define units ?-type name? ?-metric boolean? |
---|
21 | # USAGE: define units1->units2 {expr} |
---|
22 | # |
---|
23 | # Used to define a new fundamental type of units, or to define another |
---|
24 | # system of units based on a fundamental type. Once units are defined |
---|
25 | # in this manner, the "convert" function can be used to convert a number |
---|
26 | # in one system of units to another system. |
---|
27 | # ---------------------------------------------------------------------- |
---|
28 | proc Rappture::Units::define {what args} { |
---|
29 | if {[regexp {(.+)->(.+)} $what match new fndm]} { |
---|
30 | if {[llength $args] != 2} { |
---|
31 | error "wrong # args: should be \"define units1->units2 exprTo exprFrom\"" |
---|
32 | } |
---|
33 | # |
---|
34 | # Convert the units variables embedded in the conversion |
---|
35 | # expressions to something that Tcl can handle. We'll |
---|
36 | # use ${number} to represent the variables. |
---|
37 | # |
---|
38 | foreach {exprTo exprFrom} $args { break } |
---|
39 | regsub -all $new $exprTo {${number}} exprTo |
---|
40 | regsub -all $fndm $exprFrom {${number}} exprFrom |
---|
41 | |
---|
42 | Rappture::Units::System #auto $new \ |
---|
43 | -basis [list $fndm $exprTo $exprFrom] |
---|
44 | |
---|
45 | } elseif {[regexp {^/?[a-zA-Z]+[0-9]*$} $what]} { |
---|
46 | array set opts { |
---|
47 | -type "" |
---|
48 | -metric 0 |
---|
49 | } |
---|
50 | foreach {key val} $args { |
---|
51 | if {![info exists opts($key)]} { |
---|
52 | error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]" |
---|
53 | } |
---|
54 | set opts($key) $val |
---|
55 | } |
---|
56 | eval Rappture::Units::System #auto $what [array get opts] |
---|
57 | } else { |
---|
58 | error "bad units definition \"$what\": should be something like m or /cm3 or A->m" |
---|
59 | } |
---|
60 | } |
---|
61 | |
---|
62 | # ---------------------------------------------------------------------- |
---|
63 | # USAGE: convert value ?-context units? ?-to units? ?-units on/off? |
---|
64 | # |
---|
65 | # Used to convert one value with units to another value in a different |
---|
66 | # system of units. If the value has no units, then the units are taken |
---|
67 | # from the -context, if that is supplied. If the -to system is not |
---|
68 | # specified, then the value is converted to fundamental units for the |
---|
69 | # current system. |
---|
70 | # ---------------------------------------------------------------------- |
---|
71 | proc Rappture::Units::convert {value args} { |
---|
72 | array set opts { |
---|
73 | -context "" |
---|
74 | -to "" |
---|
75 | -units "on" |
---|
76 | } |
---|
77 | foreach {key val} $args { |
---|
78 | if {![info exists opts($key)]} { |
---|
79 | error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]" |
---|
80 | } |
---|
81 | set opts($key) $val |
---|
82 | } |
---|
83 | |
---|
84 | # |
---|
85 | # Parse the value into the number part and the units part. |
---|
86 | # |
---|
87 | set value [string trim $value] |
---|
88 | if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} { |
---|
89 | set mesg "bad value \"$value\": should be real number with units" |
---|
90 | if {$opts(-context) != ""} { |
---|
91 | append mesg " of [Rappture::Units::description $opts(-context)]" |
---|
92 | } |
---|
93 | error $mesg |
---|
94 | } |
---|
95 | if {$units == ""} { |
---|
96 | set units $opts(-context) |
---|
97 | } |
---|
98 | |
---|
99 | # |
---|
100 | # Try to find the object representing the current system of units. |
---|
101 | # |
---|
102 | set units [Rappture::Units::System::regularize $units] |
---|
103 | set oldsys [Rappture::Units::System::for $units] |
---|
104 | if {$oldsys == ""} { |
---|
105 | set mesg "value \"$value\" has unrecognized units" |
---|
106 | if {$opts(-context) != ""} { |
---|
107 | append mesg ".\nShould be units of [Rappture::Units::description $opts(-context)]" |
---|
108 | } |
---|
109 | error $mesg |
---|
110 | } |
---|
111 | |
---|
112 | # |
---|
113 | # Convert the number to the new system of units. |
---|
114 | # |
---|
115 | if {$opts(-to) == ""} { |
---|
116 | # no units -- return the number as is |
---|
117 | return "$number$units" |
---|
118 | } |
---|
119 | return [$oldsys convert "$number$units" $opts(-to) $opts(-units)] |
---|
120 | } |
---|
121 | |
---|
122 | # ---------------------------------------------------------------------- |
---|
123 | # USAGE: description <units> |
---|
124 | # |
---|
125 | # Returns a description for the specified system of units. The |
---|
126 | # description includes the abstract type (length, temperature, etc.) |
---|
127 | # along with a list of all compatible systems. |
---|
128 | # ---------------------------------------------------------------------- |
---|
129 | proc Rappture::Units::description {units} { |
---|
130 | set sys [Rappture::Units::System::for $units] |
---|
131 | if {$sys == ""} { |
---|
132 | return "" |
---|
133 | } |
---|
134 | set mesg [$sys cget -type] |
---|
135 | set ulist [Rappture::Units::System::all $units] |
---|
136 | if {"" != $ulist} { |
---|
137 | append mesg " ([join $ulist {, }])" |
---|
138 | } |
---|
139 | return $mesg |
---|
140 | } |
---|
141 | |
---|
142 | # ---------------------------------------------------------------------- |
---|
143 | itcl::class Rappture::Units::System { |
---|
144 | public variable basis "" |
---|
145 | public variable type "" |
---|
146 | public variable metric 0 |
---|
147 | |
---|
148 | constructor {name args} { # defined below } |
---|
149 | |
---|
150 | public method basic {} |
---|
151 | public method fundamental {} |
---|
152 | public method convert {value units showUnits} |
---|
153 | private variable _system "" ;# this system of units |
---|
154 | |
---|
155 | public proc for {units} |
---|
156 | public proc all {units} |
---|
157 | public proc regularize {units} |
---|
158 | |
---|
159 | private common _base ;# maps unit name => System obj |
---|
160 | |
---|
161 | # metric conversion prefixes |
---|
162 | private common _prefix2factor |
---|
163 | array set _prefix2factor { |
---|
164 | c 1e-2 |
---|
165 | m 1e-3 |
---|
166 | u 1e-6 |
---|
167 | n 1e-9 |
---|
168 | p 1e-12 |
---|
169 | f 1e-15 |
---|
170 | a 1e-18 |
---|
171 | k 1e+3 |
---|
172 | M 1e+6 |
---|
173 | G 1e+9 |
---|
174 | T 1e+12 |
---|
175 | P 1e+15 |
---|
176 | } |
---|
177 | } |
---|
178 | |
---|
179 | # ---------------------------------------------------------------------- |
---|
180 | # CONSTRUCTOR |
---|
181 | # ---------------------------------------------------------------------- |
---|
182 | itcl::body Rappture::Units::System::constructor {name args} { |
---|
183 | if {![regexp {^/?[a-zA-Z]+[0-9]*$} $name]} { |
---|
184 | error "bad units declaration \"$name\"" |
---|
185 | } |
---|
186 | eval configure $args |
---|
187 | |
---|
188 | # |
---|
189 | # The -basis is a list {units exprTo exprFrom}, indicating the |
---|
190 | # fundamental system of units that this new system is based on, |
---|
191 | # and the expressions that can be used to convert this new system |
---|
192 | # to and from the fundamental system. |
---|
193 | # |
---|
194 | if {$basis != ""} { |
---|
195 | foreach {base exprTo exprFrom} $basis { break } |
---|
196 | if {![info exists _base($base)]} { |
---|
197 | error "fundamental system of units \"$base\" not defined" |
---|
198 | } |
---|
199 | while {$type == "" && $base != ""} { |
---|
200 | set obj $_base($base) |
---|
201 | set type [$obj cget -type] |
---|
202 | set base [lindex [$obj cget -basis] 0] |
---|
203 | } |
---|
204 | } |
---|
205 | set _system $name |
---|
206 | set _base($name) $this |
---|
207 | } |
---|
208 | |
---|
209 | # ---------------------------------------------------------------------- |
---|
210 | # USAGE: basic |
---|
211 | # |
---|
212 | # Returns the basic system of units for the current system. The |
---|
213 | # basic units may be the only units in this system. But if this |
---|
214 | # system has "-metric 1", the basic system is the system without |
---|
215 | # any metric prefixes. |
---|
216 | # ---------------------------------------------------------------------- |
---|
217 | itcl::body Rappture::Units::System::basic {} { |
---|
218 | return $_system |
---|
219 | } |
---|
220 | |
---|
221 | # ---------------------------------------------------------------------- |
---|
222 | # USAGE: fundamental |
---|
223 | # |
---|
224 | # Returns the fundamental system of units for the current system. |
---|
225 | # For example, the current units might be degrees F, but the |
---|
226 | # fundamental system might be degrees C. The fundamental system |
---|
227 | # depends on how each system is defined. You can see it as the |
---|
228 | # right-hand side of the -> arrow, as in "F->C". |
---|
229 | # ---------------------------------------------------------------------- |
---|
230 | itcl::body Rappture::Units::System::fundamental {} { |
---|
231 | if {$basis != ""} { |
---|
232 | set sys [Rappture::Units::System::for [lindex $basis 0]] |
---|
233 | return [$sys fundamental] |
---|
234 | } |
---|
235 | return $_system |
---|
236 | } |
---|
237 | |
---|
238 | # ---------------------------------------------------------------------- |
---|
239 | # USAGE: convert value newUnits showUnits |
---|
240 | # |
---|
241 | # Converts a value with units to another value with the specified |
---|
242 | # units. The value must have units that are compatible with the |
---|
243 | # current system. Returns a string that represented the converted |
---|
244 | # number and its new units. |
---|
245 | # ---------------------------------------------------------------------- |
---|
246 | itcl::body Rappture::Units::System::convert {value newUnits showUnits} { |
---|
247 | if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} { |
---|
248 | error "bad value \"$value\": should be real number with units" |
---|
249 | } |
---|
250 | |
---|
251 | # |
---|
252 | # Check the base units coming in. They should match the base units |
---|
253 | # for the current system, or the base units for the fundamental basis. |
---|
254 | # If not, something went wrong with the caller. |
---|
255 | # |
---|
256 | set slash "" |
---|
257 | set prefix "" |
---|
258 | set power "1" |
---|
259 | if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $units match slash prefix base power]} { |
---|
260 | set baseUnits "$slash$base$power" |
---|
261 | } else { |
---|
262 | set baseUnits $units |
---|
263 | } |
---|
264 | if {![string equal $baseUnits $_system] |
---|
265 | && ![string equal $baseUnits [lindex $basis 0]]} { |
---|
266 | error "can't convert value \"$value\": should have units \"$_system\"" |
---|
267 | } |
---|
268 | |
---|
269 | # |
---|
270 | # If the number coming in has a metric prefix, convert the number |
---|
271 | # to the base system. |
---|
272 | # |
---|
273 | if {$prefix != ""} { |
---|
274 | if {$power == ""} { |
---|
275 | set power 1 |
---|
276 | } |
---|
277 | if {$slash == "/"} { |
---|
278 | set number [expr {$number/pow($_prefix2factor($prefix),$power)}] |
---|
279 | } else { |
---|
280 | set number [expr {$number*pow($_prefix2factor($prefix),$power)}] |
---|
281 | } |
---|
282 | } |
---|
283 | |
---|
284 | # |
---|
285 | # If the incoming units are a fundamental basis, then convert |
---|
286 | # the number from the basis to the current system. |
---|
287 | # |
---|
288 | if {[string equal $baseUnits [lindex $basis 0]]} { |
---|
289 | foreach {base exprTo exprFrom} $basis { break } |
---|
290 | set number [expr $exprFrom] |
---|
291 | } |
---|
292 | |
---|
293 | # |
---|
294 | # Check the base units for the new system of units. If they match |
---|
295 | # the current system, then we're almost done. Just handle the |
---|
296 | # metric prefix, if there is one. |
---|
297 | # |
---|
298 | set slash "" |
---|
299 | set prefix "" |
---|
300 | set power "1" |
---|
301 | if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $newUnits match slash prefix base power]} { |
---|
302 | set baseUnits "$slash$base$power" |
---|
303 | } else { |
---|
304 | set baseUnits $newUnits |
---|
305 | } |
---|
306 | if {[string equal $baseUnits $_system]} { |
---|
307 | if {$prefix != ""} { |
---|
308 | if {$power == ""} { |
---|
309 | set power 1 |
---|
310 | } |
---|
311 | if {$slash == "/"} { |
---|
312 | set number [expr {$number*pow($_prefix2factor($prefix),$power)}] |
---|
313 | } else { |
---|
314 | set number [expr {$number/pow($_prefix2factor($prefix),$power)}] |
---|
315 | } |
---|
316 | } |
---|
317 | if {$showUnits} { |
---|
318 | return "$number$newUnits" |
---|
319 | } |
---|
320 | return $number |
---|
321 | } |
---|
322 | |
---|
323 | # |
---|
324 | # If we want a different system of units, then convert this number |
---|
325 | # to the fundamental basis. If there is no fundamental basis, we |
---|
326 | # must already be in the fundamental basis. |
---|
327 | # |
---|
328 | set base $_system |
---|
329 | if {"" != $basis} { |
---|
330 | foreach {base exprTo exprFrom} $basis { break } |
---|
331 | set number [expr $exprTo] |
---|
332 | } |
---|
333 | |
---|
334 | set newsys [Rappture::Units::System::for $newUnits] |
---|
335 | return [$newsys convert "$number$base" $newUnits $showUnits] |
---|
336 | } |
---|
337 | |
---|
338 | # ---------------------------------------------------------------------- |
---|
339 | # CONFIGURATION OPTION: -basis |
---|
340 | # ---------------------------------------------------------------------- |
---|
341 | itcl::configbody Rappture::Units::System::basis { |
---|
342 | if {[llength $basis] != 3} { |
---|
343 | error "bad basis \"$name\": should be {units exprTo exprFrom}" |
---|
344 | } |
---|
345 | } |
---|
346 | |
---|
347 | # ---------------------------------------------------------------------- |
---|
348 | # CONFIGURATION OPTION: -metric |
---|
349 | # ---------------------------------------------------------------------- |
---|
350 | itcl::configbody Rappture::Units::System::metric { |
---|
351 | if {![string is boolean -strict $metric]} { |
---|
352 | error "bad value \"$metric\": should be boolean" |
---|
353 | } |
---|
354 | } |
---|
355 | |
---|
356 | # ---------------------------------------------------------------------- |
---|
357 | # USAGE: for units |
---|
358 | # |
---|
359 | # Returns the System object for the given system of units, or "" |
---|
360 | # if there is no system that matches the units string. |
---|
361 | # ---------------------------------------------------------------------- |
---|
362 | itcl::body Rappture::Units::System::for {units} { |
---|
363 | # |
---|
364 | # See if the units are a recognized system. If not, then try to |
---|
365 | # extract any metric prefix and see if what's left is a recognized |
---|
366 | # system. If all else fails, see if we can find a system without |
---|
367 | # the exact capitalization. The user might say "25c" instead of |
---|
368 | # "25C". Try to allow that. |
---|
369 | # |
---|
370 | if {[info exists _base($units)]} { |
---|
371 | return $_base($units) |
---|
372 | } else { |
---|
373 | set orig $units |
---|
374 | if {[regexp {^(/?)[cCmMuUnNpPfFaAkKgGtT](.+)$} $units match slash tail]} { |
---|
375 | set base "$slash$tail" |
---|
376 | if {[info exists _base($base)]} { |
---|
377 | set sys $_base($base) |
---|
378 | if {[$sys cget -metric]} { |
---|
379 | return $sys |
---|
380 | } |
---|
381 | } |
---|
382 | |
---|
383 | # check the base part for improper capitalization below... |
---|
384 | set units $base |
---|
385 | } |
---|
386 | |
---|
387 | set matching "" |
---|
388 | foreach u [array names _base] { |
---|
389 | if {[string equal -nocase $u $units]} { |
---|
390 | lappend matching $_base($u) |
---|
391 | } |
---|
392 | } |
---|
393 | if {[llength $matching] == 1} { |
---|
394 | set sys [lindex $matching 0] |
---|
395 | # |
---|
396 | # If we got rid of a metric prefix above, make sure |
---|
397 | # that the system is metric. If not, then we don't |
---|
398 | # have a match. |
---|
399 | # |
---|
400 | if {[string equal $units $orig] || [$sys cget -metric]} { |
---|
401 | return $sys |
---|
402 | } |
---|
403 | } |
---|
404 | } |
---|
405 | return "" |
---|
406 | } |
---|
407 | |
---|
408 | # ---------------------------------------------------------------------- |
---|
409 | # USAGE: all units |
---|
410 | # |
---|
411 | # Returns a list of all units compatible with the given units string. |
---|
412 | # Compatible units are determined by following all conversion |
---|
413 | # relationships that lead to the same base system. |
---|
414 | # ---------------------------------------------------------------------- |
---|
415 | itcl::body Rappture::Units::System::all {units} { |
---|
416 | set sys [Rappture::Units::System::for $units] |
---|
417 | if {$sys == ""} { |
---|
418 | return "" |
---|
419 | } |
---|
420 | |
---|
421 | if {"" != [$sys cget -basis]} { |
---|
422 | set basis [lindex [$sys cget -basis] 0] |
---|
423 | } else { |
---|
424 | set basis $units |
---|
425 | } |
---|
426 | |
---|
427 | set ulist $basis |
---|
428 | foreach u [array names _base] { |
---|
429 | set obj $_base($u) |
---|
430 | set b [lindex [$obj cget -basis] 0] |
---|
431 | if {$b == $basis} { |
---|
432 | lappend ulist $u |
---|
433 | } |
---|
434 | } |
---|
435 | return $ulist |
---|
436 | } |
---|
437 | |
---|
438 | # ---------------------------------------------------------------------- |
---|
439 | # USAGE: regularize units |
---|
440 | # |
---|
441 | # Examines the given expression of units and tries to regularize |
---|
442 | # it so it has the proper capitalization. For example, units like |
---|
443 | # "/CM3" are converted to "/cm3". If the units are not recognized, |
---|
444 | # then they are returned as-is. |
---|
445 | # ---------------------------------------------------------------------- |
---|
446 | itcl::body Rappture::Units::System::regularize {units} { |
---|
447 | set sys [for $units] |
---|
448 | if {$sys == ""} { |
---|
449 | return $units |
---|
450 | } |
---|
451 | # note: case-insensitive matching for metric prefix |
---|
452 | if {[regexp {^(/?)([cCmMuUnNpPfFaAkKgGtT]?)([a-zA-Z].+)$} $units match slash prefix tail]} { |
---|
453 | if {[regexp {^[CUNFAK]$} $prefix]} { |
---|
454 | # we know that these should be lower case |
---|
455 | set prefix [string tolower $prefix] |
---|
456 | } elseif {[regexp {^[GT]$} $prefix]} { |
---|
457 | # we know that these should be upper case |
---|
458 | set prefix [string toupper $prefix] |
---|
459 | } |
---|
460 | return "$slash$prefix[string trimleft [$sys basic] /]" |
---|
461 | } |
---|
462 | return [$sys basic] |
---|
463 | } |
---|
464 | |
---|
465 | # ---------------------------------------------------------------------- |
---|
466 | |
---|
467 | # ---------------------------------------------------------------------- |
---|
468 | # Define common units... |
---|
469 | # ---------------------------------------------------------------------- |
---|
470 | Rappture::Units::define m -type length -metric yes |
---|
471 | Rappture::Units::define A->m {A*1.0e-10} {m*1.0e10} |
---|
472 | |
---|
473 | Rappture::Units::define /m3 -type density -metric yes |
---|
474 | |
---|
475 | Rappture::Units::define C -type temperature -metric no |
---|
476 | Rappture::Units::define K->C {K-273.15} {C+273.15} |
---|
477 | Rappture::Units::define F->C {(F-32)/1.8} {(1.8*C)+32} |
---|
478 | |
---|
479 | Rappture::Units::define eV -type energy -metric yes |
---|
480 | Rappture::Units::define J->eV {J/1.602177e-19} {eV*1.602177e-19} |
---|
481 | |
---|
482 | Rappture::Units::define V -type voltage -metric yes |
---|
483 | |
---|
484 | Rappture::Units::define s -type seconds -metric yes |
---|