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

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

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