Return to QIntervalUnion.pm CVS log

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

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

# The LearningOnline Network with CAPA - LON-CAPA
# QIntervalUnion
#
# $Id: QIntervalUnion.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/>.
#

##
# A union of possibly disjoint intervals
##
package Apache::math_parser::QIntervalUnion;

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 {QInterval[]} intervals
##
sub new {
    my $class = shift;
    # we use an array to preserve order (of course purely for cosmetic reasons)
    my $self = {
        _intervals => shift,
    };
    bless $self, $class;
    
    # sanity checks
    foreach my $inter (@{$self->intervals}) {
        if (!$inter->isa(QInterval)) {
            die CalcException->new("All components of the union must be intervals.");
        }
    }
    if (scalar(@{$self->intervals}) > 0) {
        my %units = %{$self->intervals->[0]->qmin->units};
        for (my $i=1; $i < scalar(@{$self->intervals}); $i++) {
            my $inter = $self->intervals->[$i];
            foreach my $unit (keys %units) {
                if ($units{$unit} != $inter->qmin->units->{$unit}) {
                    die CalcException->new("Different units are used in the intervals.");
                }
            }
        }
    }
    
    # clone the intervals so that they can be modified independantly
    for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
        $self->intervals->[$i] = $self->intervals->[$i]->clone();
    }
    
    # reduction to make comparisons easier
    $self->reduce();
    
    return $self;
}

# Attribute helpers

##
# The intervals in the interval union, in canonical form (sorted disjoint intervals)
# @returns {QInterval[]}
##
sub intervals {
    my $self = shift;
    return $self->{_intervals};
}


##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
    my ( $self ) = @_;
    my $s = '(';
    for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
        $s .= $self->intervals->[$i]->toString();
        if ($i != scalar(@{$self->intervals}) - 1) {
            $s .= "+";
        }
    }
    $s .= ')';
    return $s;
}

##
# Equality test
# @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
    my ( $self, $qiu, $tolerance ) = @_;
    if (!$qiu->isa(QIntervalUnion)) {
        return 0;
    }
    if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
        return 0;
    }
    foreach my $inter1 (@{$self->intervals}) {
        my $found = 0;
        foreach my $inter2 (@{$qiu->intervals}) {
            if ($inter1->equals($inter2, $tolerance)) {
                $found = 1;
                last;
            }
        }
        if (!$found) {
            return 0;
        }
    }
    return 1;
}

##
# Compare this interval union with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QIntervalUnion
# (this might happen if a union of disjoint intervals is compared with a simple interval).
# @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
# @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, $qiu, $tolerance ) = @_;
    if (!$qiu->isa(QIntervalUnion)) {
        return Quantity->WRONG_TYPE;
    }
    if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
        return Quantity->WRONG_DIMENSIONS;
    }
    my @codes = ();
    foreach my $inter1 (@{$self->intervals}) {
        my $best_code = Quantity->WRONG_TYPE;
        foreach my $inter2 (@{$qiu->intervals}) {
            my $code = $inter1->compare($inter2, $tolerance);
            if ($code == Quantity->IDENTICAL) {
                $best_code = $code;
                last;
            } elsif ($code > $best_code) {
                $best_code = $code;
            }
        }
        if ($best_code != Quantity->IDENTICAL) {
            return $best_code;
        }
    }
    return Quantity->IDENTICAL;
}

##
# Turns the internal structure into canonical form (sorted disjoint intervals)
##
sub reduce {
    my ( $self ) = @_;
    my @intervals = @{$self->intervals}; # shallow copy (just to make the code easier to read)
    
    # remove empty intervals
    for (my $i=0; $i < scalar(@intervals); $i++) {
        my $inter = $intervals[$i];
        if ($inter->qmin->value == $inter->qmax->value && $inter->qminopen && $inter->qmaxopen) {
            splice(@intervals, $i, 1);
            $i--;
        }
    }
    
    # unite intervals that are not disjoint
    # (at this point we already know that units are the same, and there is no empty interval)
    for (my $i=0; $i < scalar(@intervals); $i++) {
        my $inter1 = $intervals[$i];
        for (my $j=$i+1; $j < scalar(@intervals); $j++) {
            my $inter2 = $intervals[$j];
            if ($inter1->qmax->value < $inter2->qmin->value || $inter1->qmin->value > $inter2->qmax->value) {
                next;
            }
            if ($inter1->qmax->equals($inter2->qmin) && $inter1->qmaxopen && $inter2->qminopen) {
                next;
            }
            if ($inter1->qmin->equals($inter2->qmax) && $inter1->qmaxopen && $inter2->qminopen) {
                next;
            }
            $intervals[$i] = $inter1->union($inter2);
            splice(@intervals, $j, 1);
            $i--;
            last;
        }
    }
    
    # sort the intervals
    for (my $i=0; $i < scalar(@intervals); $i++) {
        my $inter1 = $intervals[$i];
        for (my $j=$i+1; $j < scalar(@intervals); $j++) {
            my $inter2 = $intervals[$j];
            if ($inter1->qmin > $inter2->qmin) {
                $intervals[$i] = $inter2;
                $intervals[$j] = $inter1;
                $inter1 = $intervals[$i];
                $inter2 = $intervals[$j];
            }
        }
    }
    
    $self->{_intervals} = \@intervals;
}

##
# Tests if this union of intervals contains a quantity.
# @param {Quantity} q
# @returns {boolean}
##
sub contains {
    my ( $self, $q ) = @_;
    if (!$q->isa(Quantity)) {
        die CalcException->new("Second member of an interval is not a quantity.");
    }
    foreach my $inter (@{$self->intervals}) {
        if ($inter->contains($q)) {
            return 1;
        }
    }
    return 0;
}

##
# Multiplication by a Quantity
# @param {Quantity} q
# @returns {QIntervalUnion}
##
sub qmult {
    my ( $self, $q ) = @_;
    if (!$q->isa(Quantity)) {
        die CalcException->new("Intervals can only be multiplied by quantities.");
    }
    my @t = ();
    foreach my $inter (@{$self->intervals}) {
        push(@t, $inter * $q);
    }
    return QIntervalUnion->new(\@t);
}

##
# Union
# @param {QIntervalUnion|QInterval} qui
# @returns {QIntervalUnion|QInterval}
##
sub union {
    my ( $self, $qiu ) = @_;
    if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
        die CalcException->new("Cannot form a union if second  member is not an interval union or an interval.");
    }
    my @t = ();
    foreach my $inter (@{$self->intervals}) {
        push(@t, $inter->clone());
    }
    if ($qiu->isa(QInterval)) {
        push(@t, $qiu->clone());
    } else {
        foreach my $inter (@{$qiu->intervals}) {
            push(@t, $inter->clone());
        }
    }
    my $new_union = QIntervalUnion->new(\@t); # will be reduced in the constructor
    if (scalar(@{$new_union->intervals}) == 1) {
        return $new_union->intervals->[0];
    }
    return $new_union;
}

##
# Intersection
# @param {QIntervalUnion|QInterval} qui
# @returns {QIntervalUnion|QInterval}
##
sub intersection {
    my ( $self, $qiu ) = @_;
    if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
        die CalcException->new("Cannot form an intersection if second member is not an interval union or an interval.");
    }
    my @t = ();
    my $intervals2;
    if ($qiu->isa(QInterval)) {
        $intervals2 = [$qiu];
    } else {
        $intervals2 = $qiu->intervals;
    }
    foreach my $inter1 (@{$self->intervals}) {
        foreach my $inter2 (@{$intervals2}) {
            my $intersection = $inter1->intersection($inter2);
            if (!$intersection->is_empty()) {
                push(@t, $intersection);
            }
        }
    }
    my $new_qiu = QIntervalUnion->new(\@t);
    if (scalar(@{$new_qiu->intervals}) == 1) {
        return $new_qiu->intervals->[0];
    }
    return $new_qiu;
}

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


1;
__END__