Return to QInterval.pm CVS log

Up to [LON-CAPA] / loncom / homework / math_parser

- Add $Id$ line in comments for display of version.

    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__