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

Last change on this file since 6021 was 6021, checked in by ldelgass, 8 years ago

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