1: # The LearningOnline Network with CAPA - LON-CAPA
2: # QIntervalUnion
3: #
4: # $Id: QIntervalUnion.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 union of possibly disjoint intervals
24: ##
25: package Apache::math_parser::QIntervalUnion;
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: # Constructor
43: # @param {QInterval[]} intervals
44: ##
45: sub new {
46: my $class = shift;
47: # we use an array to preserve order (of course purely for cosmetic reasons)
48: my $self = {
49: _intervals => shift,
50: };
51: bless $self, $class;
52:
53: # sanity checks
54: foreach my $inter (@{$self->intervals}) {
55: if (!$inter->isa(QInterval)) {
56: die CalcException->new("All components of the union must be intervals.");
57: }
58: }
59: if (scalar(@{$self->intervals}) > 0) {
60: my %units = %{$self->intervals->[0]->qmin->units};
61: for (my $i=1; $i < scalar(@{$self->intervals}); $i++) {
62: my $inter = $self->intervals->[$i];
63: foreach my $unit (keys %units) {
64: if ($units{$unit} != $inter->qmin->units->{$unit}) {
65: die CalcException->new("Different units are used in the intervals.");
66: }
67: }
68: }
69: }
70:
71: # clone the intervals so that they can be modified independantly
72: for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
73: $self->intervals->[$i] = $self->intervals->[$i]->clone();
74: }
75:
76: # reduction to make comparisons easier
77: $self->reduce();
78:
79: return $self;
80: }
81:
82: # Attribute helpers
83:
84: ##
85: # The intervals in the interval union, in canonical form (sorted disjoint intervals)
86: # @returns {QInterval[]}
87: ##
88: sub intervals {
89: my $self = shift;
90: return $self->{_intervals};
91: }
92:
93:
94: ##
95: # Returns a readable view of the object
96: # @returns {string}
97: ##
98: sub toString {
99: my ( $self ) = @_;
100: my $s = '(';
101: for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
102: $s .= $self->intervals->[$i]->toString();
103: if ($i != scalar(@{$self->intervals}) - 1) {
104: $s .= "+";
105: }
106: }
107: $s .= ')';
108: return $s;
109: }
110:
111: ##
112: # Equality test
113: # @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
114: # @optional {string|float} tolerance
115: # @returns {boolean}
116: ##
117: sub equals {
118: my ( $self, $qiu, $tolerance ) = @_;
119: if (!$qiu->isa(QIntervalUnion)) {
120: return 0;
121: }
122: if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
123: return 0;
124: }
125: foreach my $inter1 (@{$self->intervals}) {
126: my $found = 0;
127: foreach my $inter2 (@{$qiu->intervals}) {
128: if ($inter1->equals($inter2, $tolerance)) {
129: $found = 1;
130: last;
131: }
132: }
133: if (!$found) {
134: return 0;
135: }
136: }
137: return 1;
138: }
139:
140: ##
141: # Compare this interval union with another one, and returns a code.
142: # Returns Quantity->WRONG_TYPE if the parameter is not a QIntervalUnion
143: # (this might happen if a union of disjoint intervals is compared with a simple interval).
144: # @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
145: # @optional {string|float} tolerance
146: # @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|WRONG_ENDPOINT|IDENTICAL
147: ##
148: sub compare {
149: my ( $self, $qiu, $tolerance ) = @_;
150: if (!$qiu->isa(QIntervalUnion)) {
151: return Quantity->WRONG_TYPE;
152: }
153: if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
154: return Quantity->WRONG_DIMENSIONS;
155: }
156: my @codes = ();
157: foreach my $inter1 (@{$self->intervals}) {
158: my $best_code = Quantity->WRONG_TYPE;
159: foreach my $inter2 (@{$qiu->intervals}) {
160: my $code = $inter1->compare($inter2, $tolerance);
161: if ($code == Quantity->IDENTICAL) {
162: $best_code = $code;
163: last;
164: } elsif ($code > $best_code) {
165: $best_code = $code;
166: }
167: }
168: if ($best_code != Quantity->IDENTICAL) {
169: return $best_code;
170: }
171: }
172: return Quantity->IDENTICAL;
173: }
174:
175: ##
176: # Turns the internal structure into canonical form (sorted disjoint intervals)
177: ##
178: sub reduce {
179: my ( $self ) = @_;
180: my @intervals = @{$self->intervals}; # shallow copy (just to make the code easier to read)
181:
182: # remove empty intervals
183: for (my $i=0; $i < scalar(@intervals); $i++) {
184: my $inter = $intervals[$i];
185: if ($inter->qmin->value == $inter->qmax->value && $inter->qminopen && $inter->qmaxopen) {
186: splice(@intervals, $i, 1);
187: $i--;
188: }
189: }
190:
191: # unite intervals that are not disjoint
192: # (at this point we already know that units are the same, and there is no empty interval)
193: for (my $i=0; $i < scalar(@intervals); $i++) {
194: my $inter1 = $intervals[$i];
195: for (my $j=$i+1; $j < scalar(@intervals); $j++) {
196: my $inter2 = $intervals[$j];
197: if ($inter1->qmax->value < $inter2->qmin->value || $inter1->qmin->value > $inter2->qmax->value) {
198: next;
199: }
200: if ($inter1->qmax->equals($inter2->qmin) && $inter1->qmaxopen && $inter2->qminopen) {
201: next;
202: }
203: if ($inter1->qmin->equals($inter2->qmax) && $inter1->qmaxopen && $inter2->qminopen) {
204: next;
205: }
206: $intervals[$i] = $inter1->union($inter2);
207: splice(@intervals, $j, 1);
208: $i--;
209: last;
210: }
211: }
212:
213: # sort the intervals
214: for (my $i=0; $i < scalar(@intervals); $i++) {
215: my $inter1 = $intervals[$i];
216: for (my $j=$i+1; $j < scalar(@intervals); $j++) {
217: my $inter2 = $intervals[$j];
218: if ($inter1->qmin > $inter2->qmin) {
219: $intervals[$i] = $inter2;
220: $intervals[$j] = $inter1;
221: $inter1 = $intervals[$i];
222: $inter2 = $intervals[$j];
223: }
224: }
225: }
226:
227: $self->{_intervals} = \@intervals;
228: }
229:
230: ##
231: # Tests if this union of intervals contains a quantity.
232: # @param {Quantity} q
233: # @returns {boolean}
234: ##
235: sub contains {
236: my ( $self, $q ) = @_;
237: if (!$q->isa(Quantity)) {
238: die CalcException->new("Second member of an interval is not a quantity.");
239: }
240: foreach my $inter (@{$self->intervals}) {
241: if ($inter->contains($q)) {
242: return 1;
243: }
244: }
245: return 0;
246: }
247:
248: ##
249: # Multiplication by a Quantity
250: # @param {Quantity} q
251: # @returns {QIntervalUnion}
252: ##
253: sub qmult {
254: my ( $self, $q ) = @_;
255: if (!$q->isa(Quantity)) {
256: die CalcException->new("Intervals can only be multiplied by quantities.");
257: }
258: my @t = ();
259: foreach my $inter (@{$self->intervals}) {
260: push(@t, $inter * $q);
261: }
262: return QIntervalUnion->new(\@t);
263: }
264:
265: ##
266: # Union
267: # @param {QIntervalUnion|QInterval} qui
268: # @returns {QIntervalUnion|QInterval}
269: ##
270: sub union {
271: my ( $self, $qiu ) = @_;
272: if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
273: die CalcException->new("Cannot form a union if second member is not an interval union or an interval.");
274: }
275: my @t = ();
276: foreach my $inter (@{$self->intervals}) {
277: push(@t, $inter->clone());
278: }
279: if ($qiu->isa(QInterval)) {
280: push(@t, $qiu->clone());
281: } else {
282: foreach my $inter (@{$qiu->intervals}) {
283: push(@t, $inter->clone());
284: }
285: }
286: my $new_union = QIntervalUnion->new(\@t); # will be reduced in the constructor
287: if (scalar(@{$new_union->intervals}) == 1) {
288: return $new_union->intervals->[0];
289: }
290: return $new_union;
291: }
292:
293: ##
294: # Intersection
295: # @param {QIntervalUnion|QInterval} qui
296: # @returns {QIntervalUnion|QInterval}
297: ##
298: sub intersection {
299: my ( $self, $qiu ) = @_;
300: if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
301: die CalcException->new("Cannot form an intersection if second member is not an interval union or an interval.");
302: }
303: my @t = ();
304: my $intervals2;
305: if ($qiu->isa(QInterval)) {
306: $intervals2 = [$qiu];
307: } else {
308: $intervals2 = $qiu->intervals;
309: }
310: foreach my $inter1 (@{$self->intervals}) {
311: foreach my $inter2 (@{$intervals2}) {
312: my $intersection = $inter1->intersection($inter2);
313: if (!$intersection->is_empty()) {
314: push(@t, $intersection);
315: }
316: }
317: }
318: my $new_qiu = QIntervalUnion->new(\@t);
319: if (scalar(@{$new_qiu->intervals}) == 1) {
320: return $new_qiu->intervals->[0];
321: }
322: return $new_qiu;
323: }
324:
325: ##
326: # Equals
327: # @param {Quantity|QVector|QMatrix|QSet|QInterval} qui
328: # @optional {string|float} tolerance
329: # @returns {Quantity}
330: ##
331: sub qeq {
332: my ( $self, $qui, $tolerance ) = @_;
333: my $q = $self->equals($qui, $tolerance);
334: return Quantity->new($q);
335: }
336:
337:
338: 1;
339: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to QIntervalUnion.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework / math_parser