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