source: branches/uq/lang/tcl/scripts/units.tcl @ 5708

Last change on this file since 5708 was 5708, checked in by mmh, 9 years ago

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