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

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # QSet
                      3: #
1.2     ! raeburn     4: # $Id: QSet.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: # 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__

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