File:  [LON-CAPA] / loncom / homework / math_parser / QInterval.pm
Revision 1.2: download - view: text, annotated - select for diffs
Mon Mar 13 22:31:22 2023 UTC (21 months, 2 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, version_2_11_5_msu, version_2_11_4_msu, HEAD
- Add $Id$ line in comments for display of version.

# The LearningOnline Network with CAPA - LON-CAPA
# QInterval
#
# $Id: QInterval.pm,v 1.2 2023/03/13 22:31:22 raeburn Exp $
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#

##
# An interval of quantities
##
package Apache::math_parser::QInterval;

use strict;
use warnings;
use utf8;

use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QInterval';
use aliased 'Apache::math_parser::QIntervalUnion';

use overload
    '""' => \&toString,
    '+' => \&union,
    '*' => \&qmult;


##
# Constructor
# @param {Quantity} qmin - quantity min
# @param {Quantity} qmax - quantity max
# @param {boolean} qminopen - qmin open ?
# @param {boolean} qmaxopen - qmax open ?
##
sub new {
    my $class = shift;
    my $self = {
        _qmin => shift,
        _qmax => shift,
        _qminopen => shift,
        _qmaxopen => shift,
    };
    bless $self, $class;
    my %units = %{$self->qmin->units};
    foreach my $unit (keys %units) {
        if ($units{$unit} != $self->qmax->units->{$unit}) {
            die CalcException->new("Interval creation: different units are used for the two endpoints.");
        }
    }
    if ($self->qmin > $self->qmax) {
        die CalcException->new("Interval creation: lower limit greater than upper limit.");
    }
    return $self;
}

# Attribute helpers

##
# Min quantity.
# @returns {Quantity}
##
sub qmin {
    my $self = shift;
    return $self->{_qmin};
}

##
# Max quantity.
# @returns {Quantity}
##
sub qmax {
    my $self = shift;
    return $self->{_qmax};
}

##
# Returns 1 if the interval minimum is open, 0 otherwise.
# @returns {boolean}
##
sub qminopen {
    my $self = shift;
    return $self->{_qminopen};
}

##
# Returns 1 if the interval maximum is open, 0 otherwise.
# @returns {boolean}
##
sub qmaxopen {
    my $self = shift;
    return $self->{_qmaxopen};
}


##
# Returns 1 if the interval is empty
# @returns {boolean}
##
sub is_empty {
    my ( $self ) = @_;
    if ($self->qmin->value == $self->qmax->value && $self->qminopen && $self->qmaxopen) {
        return(1);
    }
    return(0);
}

##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
    my ( $self ) = @_;
    my $s;
    if ($self->qminopen) {
        $s = '(';
    } else {
        $s = '[';
    }
    $s .= $self->qmin->toString();
    $s .= " : ";
    $s .= $self->qmax->toString();
    if ($self->qmaxopen) {
        $s .= ')';
    } else {
        $s .= ']';
    }
    return $s;
}

##
# Equality test
# @param {QInterval} inter
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
    my ( $self, $inter, $tolerance ) = @_;
    if (!$inter->isa(QInterval)) {
        return 0;
    }
    if ($self->is_empty() && $inter->is_empty()) {
        return 1;
    }
    if (!$self->qmin->equals($inter->qmin, $tolerance)) {
        return 0;
    }
    if (!$self->qmax->equals($inter->qmax, $tolerance)) {
        return 0;
    }
    if (!$self->qminopen == $inter->qminopen) {
        return 0;
    }
    if (!$self->qmaxopen == $inter->qmaxopen) {
        return 0;
    }
    return 1;
}

##
# Compare this vector with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QInterval.
# @param {QInterval|QSet|Quantity|QVector|QMatrix} inter
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|WRONG_ENDPOINT|IDENTICAL
##
sub compare {
    my ( $self, $inter, $tolerance ) = @_;
    if (!$inter->isa(QInterval)) {
        return Quantity->WRONG_TYPE;
    }
    my @codes = ();
    push(@codes, $self->qmin->compare($inter->qmin, $tolerance));
    push(@codes, $self->qmax->compare($inter->qmax, $tolerance));
    my @test_order = (Quantity->WRONG_TYPE, Quantity->WRONG_DIMENSIONS, Quantity->MISSING_UNITS, Quantity->ADDED_UNITS,
        Quantity->WRONG_UNITS, Quantity->WRONG_VALUE);
    foreach my $test (@test_order) {
        foreach my $code (@codes) {
            if ($code == $test) {
                return $test;
            }
        }
    }
    if ($self->qminopen != $inter->qminopen) {
        return Quantity->WRONG_ENDPOINT;
    }
    if ($self->qmaxopen != $inter->qmaxopen) {
        return Quantity->WRONG_ENDPOINT;
    }
    return Quantity->IDENTICAL;
}

##
# Clone this object.
# @returns {QInterval}
##
sub clone {
    my ( $self ) = @_;
    return QInterval->new($self->qmin->clone(), $self->qmax->clone(), $self->qminopen, $self->qmaxopen);
}

##
# Tests if this interval contains a quantity.
# @param {Quantity} q
# @returns {boolean}
##
sub contains {
    my ( $self, $q ) = @_;
    if (!$q->isa(Quantity)) {
        die CalcException->new("Interval contains: second member is not a quantity.");
    }
    if (!$self->qminopen && $self->qmin->equals($q)) {
        return 1;
    }
    if (!$self->qmaxopen && $self->qmax->equals($q)) {
        return 1;
    }
    if ($self->qmin < $q && $self->qmax > $q) {
        return 1;
    }
    return 0;
}

##
# Multiplication by a Quantity
# @param {Quantity} q
# @returns {QInterval}
##
sub qmult {
    my ( $self, $q ) = @_;
    if (!$q->isa(Quantity)) {
        die CalcException->new("Interval multiplication: second member is not a quantity.");
    }
    return QInterval->new($self->qmin * $q, $self->qmax * $q, $self->qminopen, $self->qmaxopen);
}

##
# Union
# @param {QInterval|QIntervalUnion} inter
# @returns {QInterval|QIntervalUnion}
##
sub union {
    my ( $self, $inter ) = @_;
    if (!$inter->isa(QInterval) && !$inter->isa(QIntervalUnion)) {
        die CalcException->new("Interval union: second member is not an interval or an interval union.");
    }
    if ($inter->isa(QIntervalUnion)) {
        return($inter->union($self));
    }
    my %units = %{$self->qmin->units};
    foreach my $unit (keys %units) {
        if ($units{$unit} != $inter->qmin->units->{$unit}) {
            die CalcException->new("Interval union: different units are used in the two intervals.");
        }
    }
    if ($self->qmax->value < $inter->qmin->value || $self->qmin->value > $inter->qmax->value) {
        return QIntervalUnion->new([$self, $inter]);
    }
    if ($self->qmax->equals($inter->qmin) && $self->qmaxopen && $inter->qminopen) {
        return QIntervalUnion->new([$self, $inter]);
    }
    if ($self->qmin->equals($inter->qmax) && $self->qmaxopen && $inter->qminopen) {
        return QIntervalUnion->new([$self, $inter]);
    }
    if ($self->qmin->value == $self->qmax->value && $self->qminopen && $self->qmaxopen) {
        # $self is an empty interval
        return QInterval->new($inter->qmin, $inter->qmax, $inter->qminopen, $inter->qmaxopen);
    }
    if ($inter->qmin->value == $inter->qmax->value && $inter->qminopen && $inter->qmaxopen) {
        # $inter is an empty interval
        return QInterval->new($self->qmin, $self->qmax, $self->qminopen, $self->qmaxopen);
    }
    my ($qmin, $qminopen);
    if ($self->qmin->value == $inter->qmin->value) {
        $qmin = $inter->qmin->clone();
        $qminopen = $self->qminopen && $inter->qminopen;
    } elsif ($self->qmin->value < $inter->qmin->value) {
        $qmin = $self->qmin->clone();
        $qminopen = $self->qminopen;
    } else {
        $qmin = $inter->qmin->clone();
        $qminopen = $inter->qminopen;
    }
    my ($qmax, $qmaxopen);
    if ($self->qmax->value == $inter->qmax->value) {
        $qmax = $self->qmax->clone();
        $qmaxopen = $self->qmaxopen && $inter->qmaxopen;
    } elsif ($self->qmax->value > $inter->qmax->value) {
        $qmax = $self->qmax->clone();
        $qmaxopen = $self->qmaxopen;
    } else {
        $qmax = $inter->qmax->clone();
        $qmaxopen = $inter->qmaxopen;
    }
    return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
}

##
# Intersection
# @param {QInterval|QIntervalUnion} inter
# @returns {QInterval}
##
sub intersection {
    my ( $self, $inter ) = @_;
    if (!$inter->isa(QInterval) && !$inter->isa(QIntervalUnion)) {
        die CalcException->new("Interval intersection: second member is not an interval or an interval union.");
    }
    if ($inter->isa(QIntervalUnion)) {
        return($inter->intersection($self));
    }
    my %units = %{$self->qmin->units};
    foreach my $unit (keys %units) {
        if ($units{$unit} != $inter->qmin->units->{$unit}) {
            die CalcException->new("Interval intersection: different units are used in the two intervals.");
        }
    }
    if ($self->qmax->value < $inter->qmin->value || $self->qmin->value > $inter->qmax->value) {
        return QInterval->new($self->qmin, $self->qmin, 1, 1); # empty interval
    }
    if ($self->qmax->equals($inter->qmin) && $self->qmaxopen && $inter->qminopen) {
        return QInterval->new($self->qmax, $self->qmax, 1, 1); # empty interval
    }
    if ($self->qmin->equals($inter->qmax) && $self->qmaxopen && $inter->qminopen) {
        return QInterval->new($self->qmin, $self->qmin, 1, 1); # empty interval
    }
    my ($qmin, $qminopen);
    if ($self->qmin->value == $inter->qmin->value) {
        $qmin = $self->qmin->clone();
        $qminopen = $self->qminopen || $inter->qminopen;
    } elsif ($self->qmin->value < $inter->qmin->value) {
        $qmin = $inter->qmin->clone();
        $qminopen = $inter->qminopen;
    } else {
        $qmin = $self->qmin->clone();
        $qminopen = $self->qminopen;
    }
    my ($qmax, $qmaxopen);
    if ($self->qmax->value == $inter->qmax->value) {
        $qmax = $self->qmax->clone();
        $qmaxopen = $self->qmaxopen || $inter->qmaxopen;
    } elsif ($self->qmax->value > $inter->qmax->value) {
        $qmax = $inter->qmax->clone();
        $qmaxopen = $inter->qmaxopen;
    } else {
        $qmax = $self->qmax->clone();
        $qmaxopen = $self->qmaxopen;
    }
    return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
}

##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} inter
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
    my ( $self, $inter, $tolerance ) = @_;
    my $q = $self->equals($inter, $tolerance);
    return Quantity->new($q);
}

1;
__END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>