Return to QSet.pm CVS log

Up to [LON-CAPA] / loncom / homework / math_parser

- Add $Id$ line in comments for display of version.

    1: # The LearningOnline Network with CAPA - LON-CAPA
    2: # QSet
    3: #
    4: # $Id: QSet.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: # A set of quantities
   24: ##
   25: package Apache::math_parser::QSet;
   26: 
   27: use strict;
   28: use warnings;
   29: use utf8;
   30: 
   31: use aliased 'Apache::math_parser::CalcException';
   32: use aliased 'Apache::math_parser::Quantity';
   33: use aliased 'Apache::math_parser::QSet';
   34: 
   35: use overload
   36:     '""' => \&toString,
   37:     '+' => \&union,
   38:     '*' => \&qmult;
   39: 
   40: ##
   41: # Constructor
   42: # @param {Quantity[]} quantities
   43: ##
   44: sub new {
   45:     my $class = shift;
   46:     # we use an array to preserve order (of course purely for cosmetic reasons)
   47:     my $self = {
   48:         _quantities => shift,
   49:     };
   50:     bless $self, $class;
   51:     # remove duplicates
   52:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
   53:         my $qi = $self->quantities->[$i];
   54:         for (my $j=0; $j < $i; $j++) {
   55:             my $qj = $self->quantities->[$j];
   56:             if ($qi->equals($qj)) {
   57:                 splice(@{$self->quantities}, $i, 1);
   58:                 $i--;
   59:                 last;
   60:             }
   61:         }
   62:     }
   63:     return $self;
   64: }
   65: 
   66: # Attribute helpers
   67: 
   68: ##
   69: # The components of the set.
   70: # @returns {Quantity[]}
   71: ##
   72: sub quantities {
   73:     my $self = shift;
   74:     return $self->{_quantities};
   75: }
   76: 
   77: 
   78: ##
   79: # Returns a readable view of the object
   80: # @returns {string}
   81: ##
   82: sub toString {
   83:     my ( $self ) = @_;
   84:     my $s = "{";
   85:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
   86:         $s .= $self->quantities->[$i]->toString();
   87:         if ($i != scalar(@{$self->quantities}) - 1) {
   88:             $s .= "; ";
   89:         }
   90:     }
   91:     $s .= "}";
   92:     return $s;
   93: }
   94: 
   95: ##
   96: # Equality test
   97: # @param {QSet} set
   98: # @optional {string|float} tolerance
   99: # @returns {boolean}
  100: ##
  101: sub equals {
  102:     my ( $self, $set, $tolerance ) = @_;
  103:     if (!$set->isa(QSet)) {
  104:         return 0;
  105:     }
  106:     if (scalar(@{$self->quantities}) != scalar(@{$set->quantities})) {
  107:         return 0;
  108:     }
  109:     foreach my $q1 (@{$self->quantities}) {
  110:         my $found = 0;
  111:         foreach my $q2 (@{$set->quantities}) {
  112:             if ($q1->equals($q2, $tolerance)) {
  113:                 $found = 1;
  114:                 last;
  115:             }
  116:         }
  117:         if (!$found) {
  118:             return 0;
  119:         }
  120:     }
  121:     return 1;
  122: }
  123: 
  124: ##
  125: # Compare this set with another one, and returns a code.
  126: # Returns Quantity->WRONG_TYPE if the parameter is not a QSet.
  127: # @param {QSet|QInterval|Quantity|QVector|QMatrix} set
  128: # @optional {string|float} tolerance
  129: # @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
  130: ##
  131: sub compare {
  132:     my ( $self, $set, $tolerance ) = @_;
  133:     if (!$set->isa(QSet)) {
  134:         return Quantity->WRONG_TYPE;
  135:     }
  136:     if (scalar(@{$self->quantities}) != scalar(@{$set->quantities})) {
  137:         return Quantity->WRONG_DIMENSIONS;
  138:     }
  139:     my @codes = ();
  140:     foreach my $q1 (@{$self->quantities}) {
  141:         my $best_code = Quantity->WRONG_TYPE;
  142:         foreach my $q2 (@{$set->quantities}) {
  143:             my $code = $q1->compare($q2, $tolerance);
  144:             if ($code == Quantity->IDENTICAL) {
  145:                 $best_code = $code;
  146:                 last;
  147:             } elsif ($code > $best_code) {
  148:                 $best_code = $code;
  149:             }
  150:         }
  151:         if ($best_code != Quantity->IDENTICAL) {
  152:             return $best_code;
  153:         }
  154:     }
  155:     return Quantity->IDENTICAL;
  156: }
  157: 
  158: ##
  159: # Multiplication by a Quantity
  160: # @param {Quantity} q
  161: # @returns {QSet}
  162: ##
  163: sub qmult {
  164:     my ( $self, $q ) = @_;
  165:     if (!$q->isa(Quantity)) {
  166:         die CalcException->new("Set multiplication: second member is not a quantity.");
  167:     }
  168:     my @t = ();
  169:     foreach my $sq (@{$self->quantities}) {
  170:         push(@t, $sq * $q);
  171:     }
  172:     return QSet->new(\@t);
  173: }
  174: 
  175: ##
  176: # Union
  177: # @param {QSet} set
  178: # @returns {QSet}
  179: ##
  180: sub union {
  181:     my ( $self, $set ) = @_;
  182:     if (!$set->isa(QSet)) {
  183:         die CalcException->new("Set union: second member is not a set.");
  184:     }
  185:     my @t = @{$self->quantities};
  186:     foreach my $q (@{$set->quantities}) {
  187:         my $found = 0;
  188:         foreach my $q2 (@t) {
  189:             if ($q->equals($q2)) {
  190:                 $found = 1;
  191:                 last;
  192:             }
  193:         }
  194:         if (!$found) {
  195:             push(@t, $q);
  196:         }
  197:     }
  198:     return QSet->new(\@t);
  199: }
  200: 
  201: ##
  202: # Intersection
  203: # @param {QSet} set
  204: # @returns {QSet}
  205: ##
  206: sub intersection {
  207:     my ( $self, $set ) = @_;
  208:     if (!$set->isa(QSet)) {
  209:         die CalcException->new("Set intersection: second member is not a set.");
  210:     }
  211:     my @t = ();
  212:     foreach my $q (@{$self->quantities}) {
  213:         my $found = 0;
  214:         foreach my $q2 (@{$set->quantities}) {
  215:             if ($q->equals($q2)) {
  216:                 $found = 1;
  217:                 last;
  218:             }
  219:         }
  220:         if ($found) {
  221:             push(@t, $q);
  222:         }
  223:     }
  224:     return QSet->new(\@t);
  225: }
  226: 
  227: ##
  228: # Equals
  229: # @param {Quantity|QVector|QMatrix|QSet|QInterval} set
  230: # @optional {string|float} tolerance
  231: # @returns {Quantity}
  232: ##
  233: sub qeq {
  234:     my ( $self, $set, $tolerance ) = @_;
  235:     my $q = $self->equals($set, $tolerance);
  236:     return Quantity->new($q);
  237: }
  238: 
  239: 
  240: 1;
  241: __END__