source: trunk/gui/scripts/units.tcl @ 2587

Last change on this file since 2587 was 1929, checked in by gah, 14 years ago
File size: 17.3 KB
Line 
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# ======================================================================
14package require Itcl
15
16namespace eval Rappture { # forward declaration }
17namespace 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# ----------------------------------------------------------------------
28proc 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# ----------------------------------------------------------------------
71proc 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# ----------------------------------------------------------------------
129proc 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# ----------------------------------------------------------------------
143itcl::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# ----------------------------------------------------------------------
182itcl::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# ----------------------------------------------------------------------
217itcl::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# ----------------------------------------------------------------------
230itcl::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# ----------------------------------------------------------------------
246itcl::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# ----------------------------------------------------------------------
341itcl::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# ----------------------------------------------------------------------
350itcl::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# ----------------------------------------------------------------------
362itcl::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# ----------------------------------------------------------------------
415itcl::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# ----------------------------------------------------------------------
446itcl::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]+[0-9]+|[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# ----------------------------------------------------------------------
470Rappture::Units::define m -type length -metric yes
471Rappture::Units::define A->m {A*1.0e-10} {m*1.0e10}
472
473Rappture::Units::define /m3 -type density -metric yes
474Rappture::Units::define /m2 -type misc -metric yes
475
476Rappture::Units::define C -type temperature -metric no
477Rappture::Units::define K->C {K-273.15} {C+273.15}
478Rappture::Units::define F->C {(F-32)/1.8} {(1.8*C)+32}
479
480Rappture::Units::define eV -type energy -metric yes
481Rappture::Units::define J->eV {J/1.602177e-19} {eV*1.602177e-19}
482
483Rappture::Units::define V -type voltage -metric yes
484
485Rappture::Units::define s -type seconds -metric yes
486# can't use min becase tcl thinks its milli-in's
487# Rappture::Units::define min->s {min*60.00} {s/60.00}
488Rappture::Units::define h->s {h*3600.00} {s/3600.00}
489Rappture::Units::define d->s {d*86400.00} {s/86400.00}
490
491# can't put mol's in because tcl thinks its milli-ol's
492# Rappture::Units::define mol -type misc -metric yes
493Rappture::Units::define Hz -type misc -metric yes
494Rappture::Units::define Bq -type misc -metric yes
495
496Rappture::Units::define deg -type angle -metric no
497Rappture::Units::define rad -type angle -metric no
498Rappture::Units::define deg->rad {deg*(3.1415926535897931/180.00)} {rad*(180.00/3.1415926535897931)}
Note: See TracBrowser for help on using the repository browser.