File:  [LON-CAPA] / loncom / homework / math_parser / Units.pm
Revision 1.2: download - view: text, annotated - select for diffs
Mon Mar 13 22:31:22 2023 UTC (14 months, 3 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_4_msu, HEAD
- Add $Id$ line in comments for display of version.

    1: # The LearningOnline Network with CAPA - LON-CAPA
    2: # Units
    3: #
    4: # $Id: Units.pm,v 1.2 2023/03/13 22:31:22 raeburn Exp $
    5: #
    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>