1: # The LearningOnline Network with CAPA - LON-CAPA
2: # QMatrix
3: #
4: # $Id: QMatrix.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 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>
![[BACK]](/icons/back.gif){kind=icon}
Return to QMatrix.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / math_parser