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