1: # The LearningOnline Network with CAPA - LON-CAPA
2: # Quantity
3: #
4: # $Id: Quantity.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 quantity (value and units)
24: ##
25: package Apache::math_parser::Quantity;
26:
27: use strict;
28: use warnings;
29: use utf8;
30:
31: use POSIX;
32: use Math::Complex; # must be after POSIX for redefinition of log10
33:
34: use aliased 'Apache::math_parser::CalcException';
35: use aliased 'Apache::math_parser::Quantity';
36: use aliased 'Apache::math_parser::QVector';
37: use aliased 'Apache::math_parser::QMatrix';
38: use aliased 'Apache::math_parser::QSet';
39: use aliased 'Apache::math_parser::QInterval';
40: use aliased 'Apache::math_parser::QIntervalUnion';
41:
42: use overload
43: '""' => \&toString,
44: '+' => \&qadd,
45: '-' => \&qsub,
46: '*' => \&qmult,
47: '/' => \&qdiv,
48: '^' => \&qpow,
49: '<' => \&qlt,
50: '<=' => \&qle,
51: '>' => \&qgt,
52: '>=' => \&qge,
53: '<=>' => \&perl_compare;
54:
55: # compare() return codes:
56: use enum qw(IDENTICAL WRONG_TYPE WRONG_DIMENSIONS MISSING_UNITS ADDED_UNITS WRONG_UNITS WRONG_VALUE WRONG_ENDPOINT);
57:
58:
59: ##
60: # Constructor
61: # @param {complex} value
62: # @optional {Object.<string, integer>} units - hash: unit name -> exponent for each SI unit
63: ##
64: sub new {
65: my $class = shift;
66: my $self = {
67: _value => shift,
68: _units => shift,
69: };
70: if ("".$self->{_value} eq "i") {
71: $self->{_value} = i;
72: } elsif ("".$self->{_value} eq "inf") {
73: $self->{_value} = 9**9**9;
74: }
75: if (!defined $self->{_units}) {
76: $self->{_units} = {
77: s => 0,
78: m => 0,
79: kg => 0,
80: K => 0,
81: A => 0,
82: mol => 0,
83: cd => 0
84: };
85: } else {
86: foreach my $unit ('s', 'm', 'kg', 'K', 'A', 'mol', 'cd') {
87: if (!defined $self->{_units}->{$unit}) {
88: $self->{_units}->{$unit} = 0;
89: }
90: }
91: }
92: bless $self, $class;
93: return $self;
94: }
95:
96: # Attribute helpers
97:
98: ##
99: # Value.
100: # @returns {Complex}
101: ##
102: sub value {
103: my $self = shift;
104: return $self->{_value};
105: }
106:
107:
108: ##
109: # Units
110: # @returns {Object.<string, integer>} hash: unit name -> exponent for each SI unit
111: ##
112: sub units {
113: my $self = shift;
114: return $self->{_units};
115: }
116:
117:
118: ##
119: # Returns a readable view of the object
120: # @returns {string}
121: ##
122: sub toString {
123: my ( $self ) = @_;
124: my $s;
125: # complex display in polar notation can be confused with vectors
126: # normally we should just have to call Math::Complex::display_format('cartesian');
127: # actually, it's supposed to be the default...
128: # but this is not working, so...
129: if ($self->value =~ /\[/) {
130: my $v = $self->value;
131: $v->display_format('cartesian');
132: $s = "".$v;
133: } else {
134: $s = $self->value;
135: }
136: foreach my $unit (keys %{$self->units}) {
137: my $e = $self->units->{$unit};
138: if ($e != 0) {
139: $s .= " ".$unit;
140: if ($e != 1) {
141: $s .= "^".$e;
142: }
143: }
144: }
145: return $s;
146: }
147:
148: ##
149: # Equality test
150: # @param {Quantity}
151: # @optional {string|float} tolerance
152: # @returns {boolean}
153: ##
154: sub equals {
155: my ( $self, $q, $tolerance ) = @_;
156: if (!$q->isa(Quantity)) {
157: return 0;
158: }
159: if (!defined $tolerance) {
160: $tolerance = 0;
161: }
162: if ($tolerance =~ /%/) {
163: my $perc = $tolerance;
164: $perc =~ s/%//;
165: $perc /= 100;
166: if (abs($self->value - $q->value) > abs($self->value * $perc)) {
167: return 0;
168: }
169: } else {
170: if (abs($self->value - $q->value) > $tolerance) {
171: return 0;
172: }
173: }
174: my %units = %{$self->units};
175: foreach my $unit (keys %units) {
176: if ($units{$unit} != $q->units->{$unit}) {
177: return 0;
178: }
179: }
180: return 1;
181: }
182:
183: ##
184: # Compare this quantity with another one, and returns a code.
185: # Returns Quantity->WRONG_TYPE if the parameter is not a Quantity.
186: # @param {Quantity|QVector|QMatrix|QSet|QInterval} q
187: # @optional {string|float} tolerance
188: # @returns {int} WRONG_TYPE|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
189: ##
190: sub compare {
191: my ( $self, $q, $tolerance ) = @_;
192: if (!$q->isa(Quantity)) {
193: return WRONG_TYPE;
194: }
195: if (!defined $tolerance) {
196: $tolerance = 0;
197: }
198: my %units = %{$self->units};
199: my $this_has_units = 0;
200: my $other_has_units = 0;
201: my $wrong_units = 0;
202: foreach my $unit (keys %units) {
203: if ($units{$unit} != 0) {
204: $this_has_units = 1;
205: }
206: if ($q->units->{$unit} != 0) {
207: $other_has_units = 1;
208: }
209: if ($units{$unit} != $q->units->{$unit}) {
210: $wrong_units = 1;
211: }
212: }
213: if ($this_has_units && !$other_has_units) {
214: return MISSING_UNITS;
215: } elsif (!$this_has_units && $other_has_units) {
216: return ADDED_UNITS;
217: }
218: if ($wrong_units) {
219: return WRONG_UNITS;
220: }
221: if ($tolerance =~ /%/) {
222: my $perc = $tolerance;
223: $perc =~ s/%//;
224: $perc /= 100;
225: if (abs($self->value - $q->value) > abs($self->value * $perc)) {
226: return WRONG_VALUE;
227: }
228: } else {
229: if (abs($self->value - $q->value) > $tolerance) {
230: return WRONG_VALUE;
231: }
232: }
233: return IDENTICAL;
234: }
235:
236: ##
237: # <=> operator.
238: # Compare this quantity with another one, and returns -1, 0 or 1.
239: # @param {Quantity} q
240: # @returns {int}
241: ##
242: sub perl_compare {
243: my ( $self, $q ) = @_;
244: if (!$q->isa(Quantity)) {
245: die CalcException->new("Quantity comparison: second member is not a quantity.");
246: }
247: $self->unitsMatch($q, 'perl_compare');
248: return($self->value <=> $q->value);
249: }
250:
251: ##
252: # Not equal
253: # @param {Quantity} q
254: # @optional {string|float} tolerance
255: # @returns {boolean}
256: ##
257: sub ne {
258: my ( $self, $q, $tolerance ) = @_;
259: if ($self->equals($q, $tolerance)) {
260: return(0);
261: } else {
262: return(1);
263: }
264: }
265:
266: ##
267: # Less than
268: # @param {Quantity} q
269: # @returns {boolean}
270: ##
271: sub lt {
272: my ( $self, $q ) = @_;
273: if (!$q->isa(Quantity)) {
274: die CalcException->new("Quantity smaller than: second member is not a quantity.");
275: }
276: $self->unitsMatch($q, 'lt');
277: if ($self->value < $q->value) {
278: return(1);
279: } else {
280: return(0);
281: }
282: }
283:
284: ##
285: # Less than or equal
286: # @param {Quantity} q
287: # @returns {boolean}
288: ##
289: sub le {
290: my ( $self, $q ) = @_;
291: if (!$q->isa(Quantity)) {
292: die CalcException->new("Quantity smaller or equal: second member is not a quantity.");
293: }
294: $self->unitsMatch($q, 'le');
295: if ($self->value <= $q->value) {
296: return(1);
297: } else {
298: return(0);
299: }
300: }
301:
302: ##
303: # Greater than
304: # @param {Quantity} q
305: # @returns {boolean}
306: ##
307: sub gt {
308: my ( $self, $q ) = @_;
309: if (!$q->isa(Quantity)) {
310: die CalcException->new("Quantity greater than: second member is not a quantity.");
311: }
312: $self->unitsMatch($q, 'gt');
313: if ($self->value > $q->value) {
314: return(1);
315: } else {
316: return(0);
317: }
318: }
319:
320: ##
321: # Greater than or equal
322: # @param {Quantity} q
323: # @returns {boolean}
324: ##
325: sub ge {
326: my ( $self, $q ) = @_;
327: if (!$q->isa(Quantity)) {
328: die CalcException->new("Quantity greater or equal: second member is not a quantity.");
329: }
330: $self->unitsMatch($q, 'ge');
331: if ($self->value >= $q->value) {
332: return(1);
333: } else {
334: return(0);
335: }
336: }
337:
338: ##
339: # Clone this object
340: # @returns {Quantity}
341: ##
342: sub clone {
343: my ( $self ) = @_;
344: my %units = %{$self->units};
345: return Quantity->new($self->value, \%units);
346: }
347:
348: ##
349: # Addition
350: # @param {Quantity} q
351: # @returns {Quantity}
352: ##
353: sub qadd {
354: my ( $self, $q ) = @_;
355: if (!$q->isa(Quantity)) {
356: die CalcException->new("Quantity addition: second member is not a quantity.");
357: }
358: my $v = $self->value + $q->value;
359: $self->unitsMatch($q, 'addition');
360: return Quantity->new($v, $self->units);
361: }
362:
363: ##
364: # Substraction
365: # @param {Quantity} q
366: # @returns {Quantity}
367: ##
368: sub qsub {
369: my ( $self, $q ) = @_;
370: if (!$q->isa(Quantity)) {
371: die CalcException->new("Quantity substraction: second member is not a quantity.");
372: }
373: my $v = $self->value - $q->value;
374: $self->unitsMatch($q, 'substraction');
375: return Quantity->new($v, $self->units);
376: }
377:
378: ##
379: # Negation
380: # @returns {Quantity}
381: ##
382: sub qneg {
383: my ( $self ) = @_;
384: my $v = - $self->value;
385: my %units = %{$self->units};
386: return Quantity->new($v, \%units);
387: }
388:
389: ##
390: # Multiplication
391: # @param {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion} qv
392: # @returns {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion}
393: ##
394: sub qmult {
395: my ( $self, $qv ) = @_;
396: if (!$qv->isa(Quantity) && !$qv->isa(QVector) && !$qv->isa(QMatrix) &&
397: !$qv->isa(QSet) && !$qv->isa(QInterval) && !$qv->isa(QIntervalUnion)) {
398: die CalcException->new("Cannot multiply with something that is not a quantity, vector, matrix, set, or interval.");
399: }
400: if ($qv->isa(QVector) || $qv->isa(QMatrix) || $qv->isa(QSet) || $qv->isa(QInterval) || $qv->isa(QIntervalUnion)) {
401: return($qv->qmult($self));
402: }
403: my $q = $qv;
404: my $v = $self->value * $q->value;
405: my %units = %{$self->units};
406: foreach my $unit (keys %units) {
407: $units{$unit} = $units{$unit} + $q->units->{$unit};
408: }
409: return Quantity->new($v, \%units);
410: }
411:
412: ##
413: # Division
414: # @param {Quantity} q
415: # @returns {Quantity}
416: ##
417: sub qdiv {
418: my ( $self, $q ) = @_;
419: if (!$q->isa(Quantity)) {
420: die CalcException->new("Cannot divide by something that is not a quantity.");
421: }
422: if ($q->value == 0) {
423: die CalcException->new("Division by zero.");
424: }
425: my $v = $self->value / $q->value;
426: my %units = %{$self->units};
427: foreach my $unit (keys %units) {
428: $units{$unit} = $units{$unit} - $q->units->{$unit};
429: }
430: return Quantity->new($v, \%units);
431: }
432:
433: ##
434: # Power
435: # @param {Quantity} q
436: # @returns {Quantity}
437: ##
438: sub qpow {
439: my ( $self, $q ) = @_;
440: if (!$q->isa(Quantity)) {
441: die CalcException->new("Cannot raise to the power of something that is not a number.");
442: }
443: my $v = $self->value ** $q->value;
444: $q->noUnits("Power");
445: my %units = %{$self->units};
446: foreach my $unit (keys %{$q->units}) {
447: $units{$unit} = $units{$unit} * $q->value;
448: }
449: return Quantity->new($v, \%units);
450: }
451:
452: ##
453: # Factorial
454: # @returns {Quantity}
455: ##
456: sub qfact {
457: my ( $self ) = @_;
458: my $v = $self->value;
459: if ($v < 0) {
460: die CalcException->new("Factorial of a number smaller than zero.");
461: }
462: # should check if integer
463: my $n = $v;
464: for (my $i=$n - 1; $i > 1; $i--) {
465: $v *= $i;
466: }
467: return Quantity->new($v, $self->units);
468: }
469:
470: ##
471: # Square root
472: # @returns {Quantity}
473: ##
474: sub qsqrt {
475: my ( $self ) = @_;
476: my $v = sqrt($self->value);
477: my %units = %{$self->units};
478: foreach my $unit (keys %units) {
479: $units{$unit} = $units{$unit} / 2;
480: }
481: return Quantity->new($v, \%units);
482: }
483:
484: ##
485: # Absolute value
486: # @returns {Quantity}
487: ##
488: sub qabs {
489: my ( $self ) = @_;
490: my $v = abs($self->value);
491: my %units = %{$self->units};
492: return Quantity->new($v, \%units);
493: }
494:
495: ##
496: # Exponential
497: # @returns {Quantity}
498: ##
499: sub qexp {
500: my ( $self ) = @_;
501: $self->noUnits("exp");
502: return Quantity->new(exp($self->value), $self->units);
503: }
504:
505: ##
506: # Natural logarithm
507: # @returns {Quantity}
508: ##
509: sub qln {
510: my ( $self ) = @_;
511: $self->noUnits("ln");
512: # this will return a complex if the value is < 0
513: #if ($self->value < 0) {
514: # die CalcException->new("Ln of number < 0");
515: #}
516: if ($self->value == 0) {
517: die CalcException->new("Natural logarithm of zero.");
518: }
519: return Quantity->new(log($self->value), $self->units);
520: }
521:
522: ##
523: # Decimal logarithm
524: # @returns {Quantity}
525: ##
526: sub qlog10 {
527: my ( $self ) = @_;
528: $self->noUnits("log10");
529: # this will return a complex if the value is < 0
530: #if ($self->value < 0) {
531: # die CalcException->new("Log10 of number < 0");
532: #}
533: if ($self->value == 0) {
534: die CalcException->new("Logarithm of zero.");
535: }
536: return Quantity->new(log10($self->value), $self->units);
537: }
538:
539: ##
540: # Modulo
541: # @param {Quantity} q
542: # @returns {Quantity}
543: ##
544: sub qmod {
545: my ( $self, $q ) = @_;
546: if (!$q->isa(Quantity)) {
547: die CalcException->new("Cannot calculate the modulus with respect to something that is not a quantity.");
548: }
549: my $v = $self->value % $q->value;
550: return Quantity->new($v, $self->units);
551: }
552:
553: ##
554: # Returns -1, 0 or 1 depending on the sign of the value
555: # @returns {Quantity}
556: ##
557: sub qsgn {
558: my ( $self ) = @_;
559: my $v;
560: if ($self->value < 0) {
561: $v = -1;
562: } elsif ($self->value > 0) {
563: $v = 1;
564: } else {
565: $v = 0;
566: }
567: return Quantity->new($v, $self->units);
568: }
569:
570: ##
571: # Returns the least integer that is greater than or equal to the value.
572: # @returns {Quantity}
573: ##
574: sub qceil {
575: my ( $self ) = @_;
576: my $v = ceil($self->value);
577: return Quantity->new($v, $self->units);
578: }
579:
580: ##
581: # Returns the largest integer that is less than or equal to the value.
582: # @returns {Quantity}
583: ##
584: sub qfloor {
585: my ( $self ) = @_;
586: my $v = floor($self->value);
587: return Quantity->new($v, $self->units);
588: }
589:
590: ##
591: # Sine
592: # @returns {Quantity}
593: ##
594: sub qsin {
595: my ( $self ) = @_;
596: $self->noUnits("sin");
597: return Quantity->new(sin($self->value), $self->units);
598: }
599:
600: ##
601: # Cosine
602: # @returns {Quantity}
603: ##
604: sub qcos {
605: my ( $self ) = @_;
606: $self->noUnits("cos");
607: return Quantity->new(cos($self->value), $self->units);
608: }
609:
610: ##
611: # Tangent
612: # @returns {Quantity}
613: ##
614: sub qtan {
615: my ( $self ) = @_;
616: $self->noUnits("tan");
617: return Quantity->new(tan($self->value), $self->units);
618: }
619:
620: ##
621: # Arcsinus
622: # @returns {Quantity}
623: ##
624: sub qasin {
625: my ( $self ) = @_;
626: $self->noUnits("asin");
627: return Quantity->new(asin($self->value), $self->units);
628: }
629:
630: ##
631: # Arccosinus
632: # @returns {Quantity}
633: ##
634: sub qacos {
635: my ( $self ) = @_;
636: $self->noUnits("acos");
637: return Quantity->new(acos($self->value), $self->units);
638: }
639:
640: ##
641: # Arctangent
642: # @returns {Quantity}
643: ##
644: sub qatan {
645: my ( $self ) = @_;
646: $self->noUnits("atan");
647: return Quantity->new(atan($self->value), $self->units);
648: }
649:
650: ##
651: # Arctangent of self/x in the range -pi to pi
652: # @param {Quantity} x
653: # @returns {Quantity}
654: ##
655: sub qatan2 {
656: my ( $self, $q ) = @_;
657: if (!$q->isa(Quantity)) {
658: die CalcException->new("Cannot calculate atan2 if second argument is not a quantity.");
659: }
660: $self->noUnits("atan2");
661: my $v = atan2($self->value, $q->value);
662: return Quantity->new($v, $self->units);
663: }
664:
665: ##
666: # Hyperbolic sinus
667: # @returns {Quantity}
668: ##
669: sub qsinh {
670: my ( $self ) = @_;
671: $self->noUnits("sinh");
672: return Quantity->new(sinh($self->value), $self->units);
673: }
674:
675: ##
676: # Hyperbolic cosinus
677: # @returns {Quantity}
678: ##
679: sub qcosh {
680: my ( $self ) = @_;
681: $self->noUnits("cosh");
682: return Quantity->new(cosh($self->value), $self->units);
683: }
684:
685: ##
686: # Hyperbolic tangent
687: # @returns {Quantity}
688: ##
689: sub qtanh {
690: my ( $self ) = @_;
691: $self->noUnits("tanh");
692: return Quantity->new(tanh($self->value), $self->units);
693: }
694:
695: ##
696: # Hyperbolic arcsinus
697: # @returns {Quantity}
698: ##
699: sub qasinh {
700: my ( $self ) = @_;
701: $self->noUnits("asinh");
702: return Quantity->new(asinh($self->value), $self->units);
703: }
704:
705: ##
706: # Hyperbolic arccosinus
707: # @returns {Quantity}
708: ##
709: sub qacosh {
710: my ( $self ) = @_;
711: $self->noUnits("acosh");
712: return Quantity->new(acosh($self->value), $self->units);
713: }
714:
715: ##
716: # Hyperbolic arctangent
717: # @returns {Quantity}
718: ##
719: sub qatanh {
720: my ( $self ) = @_;
721: $self->noUnits("atanh");
722: return Quantity->new(atanh($self->value), $self->units);
723: }
724:
725: ##
726: # Equals
727: # @param {Quantity|QVector|QMatrix|QSet|QInterval} q
728: # @optional {string|float} tolerance
729: # @returns {Quantity}
730: ##
731: sub qeq {
732: my ( $self, $q, $tolerance ) = @_;
733: my $v = $self->equals($q, $tolerance);
734: return Quantity->new($v);
735: }
736:
737: ##
738: # Less than
739: # @param {Quantity}
740: # @returns {Quantity}
741: ##
742: sub qlt {
743: my ( $self, $q ) = @_;
744: my $v = $self->lt($q);
745: return Quantity->new($v);
746: }
747:
748: ##
749: # Less than or equal
750: # @param {Quantity} q
751: # @returns {Quantity}
752: ##
753: sub qle {
754: my ( $self, $q ) = @_;
755: my $v = $self->le($q);
756: return Quantity->new($v);
757: }
758:
759: ##
760: # Greater than
761: # @param {Quantity} q
762: # @returns {Quantity}
763: ##
764: sub qgt {
765: my ( $self, $q ) = @_;
766: my $v = $self->gt($q);
767: return Quantity->new($v);
768: }
769:
770: ##
771: # Greater than or equal
772: # @param {Quantity} q
773: # @returns {Quantity}
774: ##
775: sub qge {
776: my ( $self, $q ) = @_;
777: my $v = $self->ge($q);
778: return Quantity->new($v);
779: }
780:
781: ##
782: # Dies if units do not match.
783: ##
784: sub unitsMatch {
785: my ( $self, $q, $fct_name ) = @_;
786: my %units = %{$self->units};
787: foreach my $unit (keys %units) {
788: if ($units{$unit} != $q->units->{$unit}) {
789: die CalcException->new("Units [_1] do not match.", $fct_name);
790: }
791: }
792: }
793:
794: ##
795: # Dies if there are any unit.
796: ##
797: sub noUnits {
798: my ( $self, $fct_name ) = @_;
799: my %units = %{$self->units};
800: foreach my $unit (keys %units) {
801: if ($units{$unit} != 0) {
802: die CalcException->new("Cannot calculate [_1] of something with units.", $fct_name);
803: }
804: }
805: }
806:
807: 1;
808: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to Quantity.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / math_parser