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

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # QMatrix
                      3: #
1.2     ! raeburn     4: # $Id: QMatrix.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 matrix of quantities
                     24: ##
                     25: package Apache::math_parser::QMatrix;
                     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::QVector';
                     34: use aliased 'Apache::math_parser::QMatrix';
                     35: 
                     36: use overload
                     37:     '""' => \&toString,
                     38:     '+' => \&qadd,
                     39:     '-' => \&qsub,
                     40:     '*' => \&qmult,
                     41:     '/' => \&qdiv,
                     42:     '^' => \&qpow;
                     43: 
                     44: ##
                     45: # Constructor
                     46: # @param {Quantity[][]} quantities
                     47: ##
                     48: sub new {
                     49:     my $class = shift;
                     50:     my $self = {
                     51:         _quantities => shift,
                     52:     };
                     53:     bless $self, $class;
                     54:     return $self;
                     55: }
                     56: 
                     57: # Attribute helpers
                     58: 
                     59: ##
                     60: # The components of the matrix.
                     61: # @returns {Quantity[][]}
                     62: ##
                     63: sub quantities {
                     64:     my $self = shift;
                     65:     return $self->{_quantities};
                     66: }
                     67: 
                     68: 
                     69: ##
                     70: # Returns a readable view of the object
                     71: # @returns {string}
                     72: ##
                     73: sub toString {
                     74:     my ( $self ) = @_;
                     75:     my $s = "[";
                     76:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                     77:         $s .= "[";
                     78:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                     79:             $s .= $self->quantities->[$i][$j]->toString();
                     80:             if ($j != scalar(@{$self->quantities->[$i]}) - 1) {
                     81:                 $s .= "; ";
                     82:             }
                     83:         }
                     84:         $s .= "]";
                     85:         if ($i != scalar(@{$self->quantities}) - 1) {
                     86:             $s .= "; ";
                     87:         }
                     88:     }
                     89:     $s .= "]";
                     90:     return $s;
                     91: }
                     92: 
                     93: ##
                     94: # Equality test
                     95: # @param {QMatrix} m
                     96: # @optional {string|float} tolerance
                     97: # @returns {boolean}
                     98: ##
                     99: sub equals {
                    100:     my ( $self, $m, $tolerance ) = @_;
                    101:     if (!$m->isa(QMatrix)) {
                    102:         return 0;
                    103:     }
                    104:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
                    105:         return 0;
                    106:     }
                    107:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    108:         if (scalar(@{$self->quantities->[$i]}) != scalar(@{$m->quantities->[$i]})) {
                    109:             return 0;
                    110:         }
                    111:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    112:             if (!$self->quantities->[$i][$j]->equals($m->quantities->[$i][$j], $tolerance)) {
                    113:                 return 0;
                    114:             }
                    115:         }
                    116:     }
                    117:     return 1;
                    118: }
                    119: 
                    120: ##
                    121: # Compare this matrix with another one, and returns a code.
                    122: # @param {Quantity|QVector|QMatrix|QSet|QInterval} m
                    123: # @optional {string|float} tolerance
                    124: # @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
                    125: ##
                    126: sub compare {
                    127:     my ( $self, $m, $tolerance ) = @_;
                    128:     if (!$m->isa(QMatrix)) {
                    129:         return Quantity->WRONG_TYPE;
                    130:     }
                    131:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
                    132:         return Quantity->WRONG_DIMENSIONS;
                    133:     }
                    134:     my @codes = ();
                    135:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    136:         if (scalar(@{$self->quantities->[$i]}) != scalar(@{$m->quantities->[$i]})) {
                    137:             return Quantity->WRONG_DIMENSIONS;
                    138:         }
                    139:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    140:             push(@codes, $self->quantities->[$i][$j]->compare($m->quantities->[$i][$j], $tolerance));
                    141:         }
                    142:     }
                    143:     my @test_order = (Quantity->WRONG_TYPE, Quantity->WRONG_DIMENSIONS, Quantity->MISSING_UNITS, Quantity->ADDED_UNITS,
                    144:         Quantity->WRONG_UNITS, Quantity->WRONG_VALUE);
                    145:     foreach my $test (@test_order) {
                    146:         foreach my $code (@codes) {
                    147:             if ($code == $test) {
                    148:                 return $test;
                    149:             }
                    150:         }
                    151:     }
                    152:     return Quantity->IDENTICAL;
                    153: }
                    154: 
                    155: ##
                    156: # Addition
                    157: # @param {QMatrix} m
                    158: # @returns {QMatrix}
                    159: ##
                    160: sub qadd {
                    161:     my ( $self, $m ) = @_;
                    162:     if (!$m->isa(QMatrix)) {
                    163:         die CalcException->new("Matrix addition: second member is not a matrix.");
                    164:     }
                    165:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) || 
                    166:             scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
                    167:         die CalcException->new("Matrix addition: the matrices have different sizes.");
                    168:     }
                    169:     my @t = (); # 2d array of Quantity
                    170:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    171:         $t[$i] = [];
                    172:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    173:             $t[$i][$j] = $self->quantities->[$i][$j] + $m->quantities->[$i][$j];
                    174:         }
                    175:     }
                    176:     return QMatrix->new(\@t);
                    177: }
                    178: 
                    179: ##
                    180: # Substraction
                    181: # @param {QMatrix} m
                    182: # @returns {QMatrix}
                    183: ##
                    184: sub qsub {
                    185:     my ( $self, $m ) = @_;
                    186:     if (!$m->isa(QMatrix)) {
                    187:         die CalcException->new("Matrix substraction: second member is not a matrix.");
                    188:     }
                    189:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) || 
                    190:             scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
                    191:         die CalcException->new("Matrix substraction: the matrices have different sizes.");
                    192:     }
                    193:     my @t = (); # 2d array of Quantity
                    194:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    195:         $t[$i] = [];
                    196:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    197:             $t[$i][$j] = $self->quantities->[$i][$j] - $m->quantities->[$i][$j];
                    198:         }
                    199:     }
                    200:     return QMatrix->new(\@t);
                    201: }
                    202: 
                    203: ##
                    204: # Negation
                    205: # @returns {QMatrix}
                    206: ##
                    207: sub qneg {
                    208:     my ( $self ) = @_;
                    209:     my @t = (); # 2d array of Quantity
                    210:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    211:         $t[$i] = [];
                    212:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    213:             $t[$i][$j] = $self->quantities->[$i][$j]->qneg();
                    214:         }
                    215:     }
                    216:     return QMatrix->new(\@t);
                    217: }
                    218: 
                    219: ##
                    220: # Element-by-element multiplication by a quantity, vector or matrix (like Maxima)
                    221: # @param {Quantity|QVector|QMatrix} m
                    222: # @returns {QMatrix}
                    223: ##
                    224: sub qmult {
                    225:     my ( $self, $m ) = @_;
                    226:     if (!$m->isa(Quantity) && !$m->isa(QVector) && !$m->isa(QMatrix)) {
                    227:         die CalcException->new("Matrix element-by-element multiplication: second member is not a quantity, vector or matrix.");
                    228:     }
                    229:     if ($m->isa(Quantity)) {
                    230:         my @t = (); # 2d array of Quantity
                    231:         for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    232:             $t[$i] = [];
                    233:             for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    234:                 $t[$i][$j] = $self->quantities->[$i][$j] * $m;
                    235:             }
                    236:         }
                    237:         return QMatrix->new(\@t);
                    238:     }
                    239:     if ($m->isa(QVector)) {
                    240:         if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
                    241:             die CalcException->new(
                    242: "Matrix-Vector element-by-element multiplication: the sizes do not match (use the dot product for matrix product).");
                    243:         }
                    244:         my @t = (); # 2d array of Quantity
                    245:         for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    246:             $t[$i] = [];
                    247:             for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    248:                 $t[$i][$j] = $self->quantities->[$i][$j] * $m->quantities->[$i];
                    249:             }
                    250:         }
                    251:         return QMatrix->new(\@t);
                    252:     }
                    253:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) || 
                    254:             scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
                    255:         die CalcException->new(
                    256: "Matrix element-by-element multiplication: the matrices have different sizes (use the dot product for matrix product).");
                    257:     }
                    258:     my @t = (); # 2d array of Quantity
                    259:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    260:         $t[$i] = [];
                    261:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    262:             $t[$i][$j] = $self->quantities->[$i][$j] * $m->quantities->[$i][$j];
                    263:         }
                    264:     }
                    265:     return QMatrix->new(\@t);
                    266: }
                    267: 
                    268: ##
                    269: # Element-by-element division by a quantity, vector or matrix (like Maxima)
                    270: # @param {Quantity|QVector|QMatrix} m
                    271: # @returns {QMatrix}
                    272: ##
                    273: sub qdiv {
                    274:     my ( $self, $m ) = @_;
                    275:     if (!$m->isa(Quantity) && !$m->isa(QVector) && !$m->isa(QMatrix)) {
                    276:         die CalcException->new("Matrix element-by-element division: second member is not a quantity, vector or matrix.");
                    277:     }
                    278:     if ($m->isa(Quantity)) {
                    279:         my @t = (); # 2d array of Quantity
                    280:         for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    281:             $t[$i] = [];
                    282:             for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    283:                 $t[$i][$j] = $self->quantities->[$i][$j] / $m;
                    284:             }
                    285:         }
                    286:         return QMatrix->new(\@t);
                    287:     }
                    288:     if ($m->isa(QVector)) {
                    289:         if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
                    290:             die CalcException->new("Matrix-Vector element-by-element division: the sizes do not match.");
                    291:         }
                    292:         my @t = (); # 2d array of Quantity
                    293:         for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    294:             $t[$i] = [];
                    295:             for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    296:                 $t[$i][$j] = $self->quantities->[$i][$j] / $m->quantities->[$i];
                    297:             }
                    298:         }
                    299:         return QMatrix->new(\@t);
                    300:     }
                    301:     if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) || 
                    302:             scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
                    303:         die CalcException->new("Matrix element-by-element division: the matrices have different sizes.");
                    304:     }
                    305:     my @t = (); # 2d array of Quantity
                    306:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    307:         $t[$i] = [];
                    308:         for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
                    309:             $t[$i][$j] = $self->quantities->[$i][$j] / $m->quantities->[$i][$j];
                    310:         }
                    311:     }
                    312:     return QMatrix->new(\@t);
                    313: }
                    314: 
                    315: ##
                    316: # Noncommutative multiplication by a vector or matrix
                    317: # @param {QVector|QMatrix} m
                    318: # @returns {QVector|QMatrix}
                    319: ##
                    320: sub qdot {
                    321:     my ( $self, $m ) = @_;
                    322:     if (!$m->isa(QVector) && !$m->isa(QMatrix)) {
                    323:         die CalcException->new("Matrix product: second member is not a vector or a matrix.");
                    324:     }
                    325:     if (scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities})) {
                    326:         die CalcException->new("Matrix product: the matrices sizes do not match.");
                    327:     }
                    328:     if ($m->isa(QVector)) {
                    329:         my @t = (); # array of Quantity
                    330:         for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    331:             $t[$i] = Quantity->new(0);
                    332:             for (my $j=0; $j < scalar(@{$m->quantities}); $j++) {
                    333:                 $t[$i] += $self->quantities->[$i][$j] * $m->quantities->[$j];
                    334:             }
                    335:         }
                    336:         return QVector->new(\@t);
                    337:     }
                    338:     my @t = (); # array or 2d array of Quantity
                    339:     for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
                    340:         $t[$i] = [];
                    341:         for (my $j=0; $j < scalar(@{$m->quantities->[0]}); $j++) {
                    342:             $t[$i][$j] = Quantity->new(0);
                    343:             for (my $k=0; $k < scalar(@{$m->quantities}); $k++) {
                    344:                 $t[$i][$j] += $self->quantities->[$i][$k] * $m->quantities->[$k][$j];
                    345:             }
                    346:         }
                    347:     }
                    348:     return QMatrix->new(\@t);
                    349: }
                    350: 
                    351: ##
                    352: # Power by a scalar
                    353: # @param {Quantity} q
                    354: # @returns {QMatrix}
                    355: ##
                    356: sub qpow {
                    357:     my ( $self, $q ) = @_;
                    358:     $q->noUnits("Power");
                    359:     # note: this could be optimized, see "exponentiating by squaring"
                    360:     my $m = QMatrix->new($self->quantities);
                    361:     for (my $i=0; $i < $q->value - 1; $i++) {
                    362:         $m = $m * $self;
                    363:     }
                    364:     return $m;
                    365: }
                    366: 
                    367: ##
                    368: # Equals
                    369: # @param {Quantity|QVector|QMatrix|QSet|QInterval} m
                    370: # @optional {string|float} tolerance
                    371: # @returns {Quantity}
                    372: ##
                    373: sub qeq {
                    374:     my ( $self, $m, $tolerance ) = @_;
                    375:     my $q = $self->equals($m, $tolerance);
                    376:     return Quantity->new($q);
                    377: }
                    378: 
                    379: 1;
                    380: __END__

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