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

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

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