Annotation of loncom/homework/math_parser/Units.pm, revision 1.2

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # Units
                      3: #
1.2     ! raeburn     4: # $Id: Units.pm,v 1.2 2023/03/13 18:30:00 raeburn Exp $
        !             5: #
1.1       damieng     6: # Copyright (C) 2014 Michigan State University Board of Trustees
                      7: #
                      8: # This program is free software: you can redistribute it and/or modify
                      9: # it under the terms of the GNU General Public License as published by
                     10: # the Free Software Foundation, either version 3 of the License, or
                     11: # (at your option) any later version.
                     12: #
                     13: # This program is distributed in the hope that it will be useful,
                     14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
                     16: # GNU General Public License for more details.
                     17: #
                     18: # You should have received a copy of the GNU General Public License
                     19: # along with this program. If not, see <http://www.gnu.org/licenses/>.
                     20: #
                     21: 
                     22: ##
                     23: # Loads and converts units
                     24: ##
                     25: package Apache::math_parser::Units;
                     26: 
                     27: use strict;
                     28: use warnings;
                     29: use utf8;
                     30: 
                     31: use JSON::DWIW;
                     32: use File::Slurp;
                     33: 
                     34: use aliased 'Apache::math_parser::CalcException';
                     35: use aliased 'Apache::math_parser::Parser';
                     36: use aliased 'Apache::math_parser::Quantity';
                     37: 
                     38: use vars qw(%perlvar);
                     39: 
                     40: 
                     41: ##
                     42: # Constructor
                     43: ##
                     44: sub new {
                     45:     my $class = shift;
                     46:     my $self = {
                     47:         _base => [], # array with the names
                     48:         _prefix => {}, # hash symbol -> factor
                     49:         _derived => {}, # hash symbol -> convert
                     50:         _parser => Parser->new(1, 1),
                     51:     };
                     52:     bless $self, $class;
                     53:     $self->loadUnits();
                     54:     return $self;
                     55: }
                     56: 
                     57: # Attribute helpers
                     58: 
                     59: sub base {
                     60:     my $self = shift;
                     61:     return $self->{_base};
                     62: }
                     63: sub prefix {
                     64:     my $self = shift;
                     65:     return $self->{_prefix};
                     66: }
                     67: sub derived {
                     68:     my $self = shift;
                     69:     return $self->{_derived};
                     70: }
                     71: sub parser {
                     72:     my $self = shift;
                     73:     return $self->{_parser};
                     74: }
                     75: 
                     76: ##
                     77: # Loads units from units.json
                     78: ##
                     79: sub loadUnits {
                     80:     my ( $self ) = @_;
                     81:     my $units_txt = read_file("$Apache::lonnet::perlvar{'lonTabDir'}/units.json");
                     82:     my $jsunits = JSON::DWIW->new->from_json($units_txt);
                     83:     for (my $i=0; $i < scalar(@{$jsunits->{"base"}}); $i++) {
                     84:         my $base = $jsunits->{"base"}->[$i];
                     85:         push(@{$self->{_base}}, $base->{"symbol"});
                     86:     }
                     87:     for (my $i=0; $i < scalar(@{$jsunits->{"prefix"}}); $i++) {
                     88:         my $prefix = $jsunits->{"prefix"}->[$i];
                     89:         $self->{_prefix}->{$prefix->{"symbol"}} = $prefix->{"factor"};
                     90:     }
                     91:     for (my $i=0; $i < scalar(@{$jsunits->{"derived"}}); $i++) {
                     92:         my $derived = $jsunits->{"derived"}->[$i];
                     93:         $self->{_derived}->{$derived->{"symbol"}} = $derived->{"convert"};
                     94:     }
                     95: }
                     96: 
                     97: ##
                     98: # Converts a unit name into a Quantity. Throws an exception if the unit is not known.
                     99: # @param {CalcEnv} env - Calculation environment
                    100: # @param {string} name - the unit name
                    101: # @returns {Quantity}
                    102: ##
                    103: sub convertToSI {
                    104:     my ( $self, $env, $name ) = @_;
                    105:     
                    106:     # possible speed optimization: we could cache the result
                    107:     
                    108:     # check derived units first
                    109:     my $convert = $self->derived->{$name};
                    110:     if (defined $convert) {
                    111:         my $root = $self->parser->parse($convert);
                    112:         return $root->calc($env);
                    113:     }
                    114:     # then check base units, without or with a prefix
                    115:     for (my $i=0; $i < scalar(@{$self->base}); $i++) {
                    116:         my $base = $self->base->[$i];
                    117:         if ($name eq $base) {
                    118:             return $self->baseQuantity($base);
                    119:         } else {
                    120:             my $base2;
                    121:             if ($base eq "kg") {
                    122:                 $base2 = "g";
                    123:             } else {
                    124:                 $base2 = $base;
                    125:             }
                    126:             if ($name =~ /$base2$/) {
                    127:                 # look for a prefix
                    128:                 my $prefix = $self->prefix->{substr($name, 0, length($name) - length($base2))};
                    129:                 if (defined $prefix) {
                    130:                     my $v = $prefix;
                    131:                     $v =~ s/10\^/1E/;
                    132:                     if ($base2 eq "g") {
                    133:                         $v /= 1000;
                    134:                     }
                    135:                     return $self->baseQuantity($base) * Quantity->new($v);
                    136:                 }
                    137:             }
                    138:         }
                    139:     }
                    140:     # now check derived units with a prefix
                    141:     foreach my $derived_name (keys(%{$self->derived})) {
                    142:         if ($name =~ /$derived_name$/) {
                    143:             my $prefix_v = $self->prefix->{substr($name, 0, length($name) - length($derived_name))};
                    144:             if (defined $prefix_v) {
                    145:                 $prefix_v =~ s/10\^/1E/;
                    146:                 my $convert = $self->derived->{$derived_name};
                    147:                 my $root = $self->parser->parse($convert);
                    148:                 my $derived_v = $root->calc($env);
                    149:                 return $derived_v * Quantity->new($prefix_v);
                    150:             }
                    151:         }
                    152:     }
                    153:     die CalcException->new("Unit not found: [_1]", $name);
                    154: }
                    155: 
                    156: ##
                    157: # Returns the Quantity for a base unit name
                    158: # @param {string} name - the unit name
                    159: # @returns {Quantity}
                    160: ##
                    161: sub baseQuantity {
                    162:     my ( $self, $name ) = @_;
                    163:     my %h = (s => 0, m => 0, kg => 0, K => 0, A => 0, mol => 0, cd => 0);
                    164:     $h{$name} = 1;
                    165:     return Quantity->new(1, \%h);
                    166: }
                    167: 
                    168: 1;
                    169: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>