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