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

Last change on this file since 83 was 83, checked in by dkearney, 19 years ago
  1. More cleaning of RpUnits and RpLibrary? code
  2. added rp_result code to c++/fortran/c code
  3. added rp_children, rp_lib_node[comp,type,id] for fortran code (need to test)
  4. adjusted convert function to recognize statements as follows:

convert("5J","neV")
convert("3.12075e+28neV","J")

  1. made joules a metric unit in RpUnits.cc
  2. tested examples/app-fermi/fortran/fermi.f with new rappture library.

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