Annotation of loncom/homework/math_parser/QInterval.pm, revision 1.2

1.1       damieng     1: # The LearningOnline Network with CAPA - LON-CAPA
                      2: # QInterval
                      3: #
1.2     ! raeburn     4: # $Id: QInterval.pm,v 1.2 2023/03/13 18:30:00 raeburn Exp $
        !             5: #
1.1       damieng     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>