source: branches/1.6/lang/tcl/scripts/units.tcl @ 6221

Last change on this file since 6221 was 5894, checked in by gah, 9 years ago

fix switch bug: value may start with a minus
File size: 19.5 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# ----------------------------------------------------------------------
65# USAGE: mcheck_range value {min ""} {max ""}
66#
67# Checks a value or PDF to determine if is is in a required range.
68# Automatically does unit conversion if necessary.
69# Returns value if OK.  Error if out-of-range
70# Examples:
71#    [mcheck_range "gaussian 0C 1C" 200K 500K] returns 1
72#    [mcheck_range "uniform 100 200" 150 250] returns 0
73#    [mcheck_range 100 0 200] returns 1
74# ----------------------------------------------------------------------
75
76proc Rappture::Units::_check_range {value min max units} {
77    # puts "_check_range $value min=$min max=$max units=$units"
78    # make sure the value has units
79    if {$units != ""} {
80        set value [Rappture::Units::convert $value -context $units]
81        # for comparisons, remove units
82        set nv [Rappture::Units::convert $value -context $units -units off]
83        # get the units for the value
84        set newunits [Rappture::Units::Search::for $value]
85    } else {
86        set nv $value
87    }
88
89    if {"" != $min} {
90        if {"" != $units} {
91            # compute the minimum in the new units
92            set minv [Rappture::Units::convert $min -to $newunits -context $units  -units off]
93            # same, but include units for printing
94            set convMinVal [Rappture::Units::convert $min -to $newunits -context $units]
95        } else {
96            set minv $min
97            set convMinVal $min
98        }
99        if {$nv < $minv} {
100            error "Minimum value allowed here is $convMinVal"
101        }
102    }
103    if {"" != $max} {
104        if {"" != $units} {
105            # compute the maximum in the new units
106            set maxv [Rappture::Units::convert $max -to $newunits -context $units -units off]
107            # same, but include units for printing
108            set convMaxVal [Rappture::Units::convert $max -to $newunits -context $units ]
109        } else {
110            set maxv $max
111            set convMaxVal $max
112        }
113        if {$nv > $maxv} {
114            error "Maximum value allowed here is $convMaxVal"
115        }
116    }
117    return $value
118}
119
120proc Rappture::Units::mcheck_range {value {min ""} {max ""} {units ""}} {
121    # puts "mcheck_range $value min=$min max=$max units=$units"
122
123    switch -- [lindex $value 0] {
124        normal - gaussian {
125            # get the mean
126            set mean [_check_range [lindex $value 1] $min $max $units]
127            if {$units == ""} {
128                set dev [lindex $value 2]
129                set ndev $dev
130            } else {
131                set dev [Rappture::Units::convert [lindex $value 2] -context $units]
132                set ndev [Rappture::Units::convert $dev -units off]
133            }
134            if {$ndev <= 0} {
135                error "Deviation must be positive."
136            }
137            return [list gaussian $mean $dev]
138        }
139        uniform {
140            set min [_check_range [lindex $value 1] $min $max $units]
141            set max [_check_range [lindex $value 2] $min $max $units]
142            return [list uniform $min $max]
143        }
144        exact  {
145            return [_check_range [lindex $value 1] $min $max $units]
146        }
147        default {
148            return [_check_range [lindex $value 0] $min $max $units]
149        }
150    }
151}
152
153# ----------------------------------------------------------------------
154# USAGE: mconvert value ?-context units? ?-to units? ?-units on/off?
155#
156# This version of convert() converts multiple values.  Used when the
157# value could be a range or probability density function (PDF).
158# Examples:
159#    gaussian 100k 1k
160#    uniform 0eV 10eV
161#    42
162#    exact 42
163# ----------------------------------------------------------------------
164
165proc Rappture::Units::mconvert {value args} {
166    # puts "mconvert $value : $args"
167    array set opts {
168        -context ""
169        -to ""
170        -units "on"
171    }
172
173    set value [split $value]
174
175    switch -- [lindex $value 0] {
176        normal - gaussian {
177            set valtype gaussian
178            set vals [lrange $value 1 2]
179            set convtype {0 1}
180        }
181        uniform {
182            set valtype uniform
183            set vals [lrange $value 1 2]
184            set convtype {0 0}
185        }
186        exact  {
187            set valtype ""
188            set vals [lindex $value 1]
189            set convtype {0}
190        }
191        default {
192            set valtype ""
193            set vals $value
194            set convtype {0}
195        }
196    }
197
198    foreach {key val} $args {
199        if {![info exists opts($key)]} {
200            error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]"
201        }
202        set opts($key) $val
203    }
204
205    set newval $valtype
206    foreach val $vals ctype $convtype {
207        if {$ctype == 1} {
208            # This code handles unit conversion for deltas (changes).
209            # For example, if we want a standard deviation of 10C converted
210            # to Kelvin, that is 10K, NOT a standard deviation of 283.15K.
211            set units [Rappture::Units::Search::for $val]
212            set base [eval Rappture::Units::convert 0$units $args -units off]
213            set new [eval Rappture::Units::convert $val $args -units off]
214            set delta [expr $new - $base]
215            set val $delta$opts(-to)
216        }
217        # tcl 8.5 allows us to do this:
218        # lappend newval [Rappture::Units::convert $val {*}$args]
219        # but we are using tcl8.4 so we use eval :^(
220        lappend newval [eval Rappture::Units::convert $val $args]
221    }
222    return $newval
223}
224
225# ----------------------------------------------------------------------
226# USAGE: convert value ?-context units? ?-to units? ?-units on/off?
227#
228# Used to convert one value with units to another value in a different
229# system of units.  If the value has no units, then the units are taken
230# from the -context, if that is supplied.  If the -to system is not
231# specified, then the value is converted to fundamental units for the
232# current system.
233# ----------------------------------------------------------------------
234# proc Rappture::Units::convert {value args} {}
235# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
236
237
238# ----------------------------------------------------------------------
239# USAGE: description <units>
240#
241# Returns a description for the specified system of units.  The
242# description includes the abstract type (length, temperature, etc.)
243# along with a list of all compatible systems.
244# ----------------------------------------------------------------------
245# proc Rappture::Units::description {units} {}
246# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
247
248
249# ----------------------------------------------------------------------
250itcl::class Rappture::Units::System {
251    public variable basis ""
252    public variable type ""
253    public variable metric 0
254
255    constructor {name args} { # defined below }
256
257    public method basic {}
258    public method fundamental {}
259    public method convert {value units showUnits}
260    private variable _system ""  ;# this system of units
261
262    # These are in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
263    # public proc for {units}
264    # public proc all {units}
265
266    public proc regularize {units}
267
268    private common _base  ;# maps unit name => System obj
269
270    # metric conversion prefixes
271    private common _prefix2factor
272    array set _prefix2factor {
273        c  1e-2
274        m  1e-3
275        u  1e-6
276        n  1e-9
277        p  1e-12
278        f  1e-15
279        a  1e-18
280        k  1e+3
281        M  1e+6
282        G  1e+9
283        T  1e+12
284        P  1e+15
285    }
286}
287
288# ----------------------------------------------------------------------
289# CONSTRUCTOR
290# ----------------------------------------------------------------------
291itcl::body Rappture::Units::System::constructor {name args} {
292    if {![regexp {^/?[a-zA-Z]+[0-9]*$} $name]} {
293        error "bad units declaration \"$name\""
294    }
295    eval configure $args
296
297    #
298    # The -basis is a list {units exprTo exprFrom}, indicating the
299    # fundamental system of units that this new system is based on,
300    # and the expressions that can be used to convert this new system
301    # to and from the fundamental system.
302    #
303    if {$basis != ""} {
304        foreach {base exprTo exprFrom} $basis { break }
305        if {![info exists _base($base)]} {
306            error "fundamental system of units \"$base\" not defined"
307        }
308        while {$type == "" && $base != ""} {
309            set obj $_base($base)
310            set type [$obj cget -type]
311            set base [lindex [$obj cget -basis] 0]
312        }
313    }
314    set _system $name
315    set _base($name) $this
316}
317
318# ----------------------------------------------------------------------
319# USAGE: basic
320#
321# Returns the basic system of units for the current system.  The
322# basic units may be the only units in this system.  But if this
323# system has "-metric 1", the basic system is the system without
324# any metric prefixes.
325# ----------------------------------------------------------------------
326itcl::body Rappture::Units::System::basic {} {
327    return $_system
328}
329
330# ----------------------------------------------------------------------
331# USAGE: fundamental
332#
333# Returns the fundamental system of units for the current system.
334# For example, the current units might be degrees F, but the
335# fundamental system might be degrees C.  The fundamental system
336# depends on how each system is defined.  You can see it as the
337# right-hand side of the -> arrow, as in "F->C".
338# ----------------------------------------------------------------------
339itcl::body Rappture::Units::System::fundamental {} {
340    if {$basis != ""} {
341        set sys [Rappture::Units::System::for [lindex $basis 0]]
342        return [$sys fundamental]
343    }
344    return $_system
345}
346
347# ----------------------------------------------------------------------
348# USAGE: convert value newUnits showUnits
349#
350# Converts a value with units to another value with the specified
351# units.  The value must have units that are compatible with the
352# current system.  Returns a string that represented the converted
353# number and its new units.
354# ----------------------------------------------------------------------
355itcl::body Rappture::Units::System::convert {value newUnits showUnits} {
356    if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} {
357        error "bad value \"$value\": should be real number with units"
358    }
359
360    #
361    # Check the base units coming in.  They should match the base units
362    # for the current system, or the base units for the fundamental basis.
363    # If not, something went wrong with the caller.
364    #
365    set slash ""
366    set prefix ""
367    set power "1"
368    if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $units match slash prefix base power]} {
369        set baseUnits "$slash$base$power"
370    } else {
371        set baseUnits $units
372    }
373    if {![string equal $baseUnits $_system]
374          && ![string equal $baseUnits [lindex $basis 0]]} {
375        error "can't convert value \"$value\": should have units \"$_system\""
376    }
377
378    #
379    # If the number coming in has a metric prefix, convert the number
380    # to the base system.
381    #
382    if {$prefix != ""} {
383        if {$power == ""} {
384            set power 1
385        }
386        if {$slash == "/"} {
387            set number [expr {$number/pow($_prefix2factor($prefix),$power)}]
388        } else {
389            set number [expr {$number*pow($_prefix2factor($prefix),$power)}]
390        }
391    }
392
393    #
394    # If the incoming units are a fundamental basis, then convert
395    # the number from the basis to the current system.
396    #
397    if {[string equal $baseUnits [lindex $basis 0]]} {
398        foreach {base exprTo exprFrom} $basis { break }
399        set number [expr $exprFrom]
400    }
401
402    #
403    # Check the base units for the new system of units.  If they match
404    # the current system, then we're almost done.  Just handle the
405    # metric prefix, if there is one.
406    #
407    set slash ""
408    set prefix ""
409    set power "1"
410    if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $newUnits match slash prefix base power]} {
411        set baseUnits "$slash$base$power"
412    } else {
413        set baseUnits $newUnits
414    }
415    if {[string equal $baseUnits $_system]} {
416        if {$prefix != ""} {
417            if {$power == ""} {
418                set power 1
419            }
420            if {$slash == "/"} {
421                set number [expr {$number*pow($_prefix2factor($prefix),$power)}]
422            } else {
423                set number [expr {$number/pow($_prefix2factor($prefix),$power)}]
424            }
425        }
426        if {$showUnits} {
427            return "$number$newUnits"
428        }
429        return $number
430    }
431
432    #
433    # If we want a different system of units, then convert this number
434    # to the fundamental basis.  If there is no fundamental basis, we
435    # must already be in the fundamental basis.
436    #
437    set base $_system
438    if {"" != $basis} {
439        foreach {base exprTo exprFrom} $basis { break }
440        set number [expr $exprTo]
441    }
442
443    set newsys [Rappture::Units::System::for $newUnits]
444    return [$newsys convert "$number$base" $newUnits $showUnits]
445}
446
447# ----------------------------------------------------------------------
448# CONFIGURATION OPTION: -basis
449# ----------------------------------------------------------------------
450itcl::configbody Rappture::Units::System::basis {
451    if {[llength $basis] != 3} {
452        error "bad basis \"$name\": should be {units exprTo exprFrom}"
453    }
454}
455
456# ----------------------------------------------------------------------
457# CONFIGURATION OPTION: -metric
458# ----------------------------------------------------------------------
459itcl::configbody Rappture::Units::System::metric {
460    if {![string is boolean -strict $metric]} {
461        error "bad value \"$metric\": should be boolean"
462    }
463}
464
465# ----------------------------------------------------------------------
466# USAGE: for units
467#
468# Returns the System object for the given system of units, or ""
469# if there is no system that matches the units string.
470# ----------------------------------------------------------------------
471# itcl::body Rappture::Units::System::for {units} {}
472# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
473
474
475# ----------------------------------------------------------------------
476# USAGE: all units
477#
478# Returns a list of all units compatible with the given units string.
479# Compatible units are determined by following all conversion
480# relationships that lead to the same base system.
481# ----------------------------------------------------------------------
482# itcl::body Rappture::Units::System::all {units} {}
483# Actual implementation is in rappture/lang/tcl/src/RpUnitsTclInterface.cc.
484
485
486# ----------------------------------------------------------------------
487# USAGE: regularize units
488#
489# Examines the given expression of units and tries to regularize
490# it so it has the proper capitalization.  For example, units like
491# "/CM3" are converted to "/cm3".  If the units are not recognized,
492# then they are returned as-is.
493# ----------------------------------------------------------------------
494itcl::body Rappture::Units::System::regularize {units} {
495    set sys [for $units]
496    if {$sys == ""} {
497        return $units
498    }
499    # note: case-insensitive matching for metric prefix
500    if {[regexp {^(/?)([cCmMuUnNpPfFaAkKgGtT]?)([a-zA-Z]+[0-9]+|[a-zA-Z]+)$} $units match slash prefix tail]} {
501        if {[regexp {^[CUNFAK]$} $prefix]} {
502            # we know that these should be lower case
503            set prefix [string tolower $prefix]
504        } elseif {[regexp {^[GT]$} $prefix]} {
505            # we know that these should be upper case
506            set prefix [string toupper $prefix]
507        }
508        return "$slash$prefix[string trimleft [$sys basic] /]"
509    }
510    return [$sys basic]
511}
512
513# ----------------------------------------------------------------------
514
515# ----------------------------------------------------------------------
516# Define common units...
517# ----------------------------------------------------------------------
518Rappture::Units::define m -type length -metric yes
519Rappture::Units::define A->m {A*1.0e-10} {m*1.0e10}
520
521Rappture::Units::define /m3 -type density -metric yes
522Rappture::Units::define /m2 -type misc -metric yes
523
524Rappture::Units::define C -type temperature -metric no
525Rappture::Units::define K->C {K-273.15} {C+273.15}
526Rappture::Units::define F->C {(F-32)/1.8} {(1.8*C)+32}
527
528Rappture::Units::define eV -type energy -metric yes
529Rappture::Units::define J->eV {J/1.602177e-19} {eV*1.602177e-19}
530
531Rappture::Units::define V -type voltage -metric yes
532
533Rappture::Units::define s -type seconds -metric yes
534# can't use min becase tcl thinks its milli-in's
535# Rappture::Units::define min->s {min*60.00} {s/60.00}
536Rappture::Units::define h->s {h*3600.00} {s/3600.00}
537Rappture::Units::define d->s {d*86400.00} {s/86400.00}
538
539# can't put mol's in because tcl thinks its milli-ol's
540# Rappture::Units::define mol -type misc -metric yes
541Rappture::Units::define Hz -type misc -metric yes
542Rappture::Units::define Bq -type misc -metric yes
543
544Rappture::Units::define deg -type angle -metric no
545Rappture::Units::define rad -type angle -metric no
546Rappture::Units::define deg->rad {deg*(3.1415926535897931/180.00)} {rad*(180.00/3.1415926535897931)}
Note: See TracBrowser for help on using the repository browser.