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

Last change on this file since 1 was 1, checked in by mmc, 17 years ago

initial import

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