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

Last change on this file since 5044 was 3330, checked in by gah, 11 years ago

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