=head1 NAME

iPE::Util::Interval - An interval relative to either end of a set, such as a feature or set of features.

=head1 DESCRIPTION

This object allows the "L" and "N" notation in the parameter template file and translates them to real life coordinates.  For example, if a model within a state feature occurs from positions 0 to 10, this will translate to the beginning coordinate of the feature and the 10th coordinate of the feature.  This can also be relative to the end of the feature, such as "L-10" and "L-1," which would translate to the 10th to last and last coordinate of the feature.

This object also allows the interval (.,.), the default interval for all undefined regions, but will not allow only one "." and a number.

=head1 FUNCTIONS

=over 8

=cut

package iPE::Util::Interval;
use iPE;
use iPE::Util::BoundaryCoordinate;
use base("Exporter");
use Carp;
use strict;

our @EXPORT = qw(intersection includes cmpBoundaryCoords);

=item new (memberHash)

Creates a new interval.  Requires the following keys defined in the member hash reference:

=over 8

=item low

The low coordinate of the interval

=item high

The high coordinate of the interval

=item letter

The letter that denotes the last coordinate or element in the set, for example "L" or "N."

=item object (optional)

Pass in an object to associate with the interval, in case you wish to recover it, for example, in an L<iPE::Util::Overlap> grouping.

=back

Returns undef if the interval is poorly formed.

=cut

sub new {
    my ($class, $m) = @_;
    my $this = bless {}, $class;

    croak "Incomplete instantiation of $class;\n".
        "required fields are high, low and letter.\n"
        if (!defined $m->{low} || !defined $m->{high} || !defined $m->{letter});

    $this->{letter_} = $m->{letter};
    $this->{low_}  = new iPE::Util::BoundaryCoordinate($m->{low}, $m->{letter});
    $this->{high_} = new iPE::Util::BoundaryCoordinate($m->{high},$m->{letter});
    $this->{object_} = $m->{object};

    #check if "." was used with a number (doesn't make sense)
    if(($this->{low_}->coord eq "." && $this->{high_}->coord ne ".") ||
       ($this->{low_}->coord ne "." && $this->{high_}->coord eq ".")) {
        croak "The interval (.,.) is the only legal \".\" interval.\n";
    }

    if($this->{low_}->coord ne "." && $this->{high_}->coord ne "." && 
        (($this->{low_}->isEnd == $this->{high_}->isEnd 
            && $this->{low_}->numeral > $this->{high_}->numeral) ||
            $this->{low_}->isEnd && !$this->{high_}->isEnd)) {
        croak "$m->{low} is greater than $m->{high} and shouldn't be.\n";
    }

    return $this;
}

=item clone ()

Return a new copy of the calling object

=cut
sub clone {
    my ($this) = @_;
    my $clone = bless { %$this }, ref($this);
    $clone->{low_} = $this->low->clone;
    $clone->{high_} = $this->high->clone;
    return $clone;
}

=head2 high (), low (), letter (), object ()

These are accessor functions which should exactly return the paramters you passed to new ().

=cut

sub low      { shift->{low_}     }
sub high     { shift->{high_}    }
sub letter   { shift->{letter_}  }
sub object   { shift->{object_}  }

=item format ()

Format an interval for outputting.

=cut
sub format {
    my ($this) = @_;
    return "(".$this->low->format.", ".$this->high->format.")";
}

=item translate (low, high)

Translates the interval from the abstract interval defined by this object to a concrete interval by the given coordinates.  For example, if the Interval object object was construted with 1 and L-1, the interval 100 to 110 would translate to (101, 109).  This function returns an array comprised of the low and high coordinates in that order.

=cut
sub translate {
    my ($this, $low, $high) = @_;
    return ($this->low->translate($low, $high), 
            $this->high->translate($low, $high));
}

=item length ()

If both the high and low ends of the interval were defined by the beginning or end of the parent region, then the length of the interval is fixed.  If this is the case, you may call this function to get the length of the interval.  If they were not, a warning is displayed and undef is returned.

=cut
sub length {
    my ($this) = @_;
    if($this->low->isEnd != $this->high->isEnd) {
        warn __PACKAGE__.": attempt to get the length of an interval (".
            $this->low.", ".$this->high.")\n";
        return undef;
    }
    return ($this->high->numeral-$this->low->numeral+1);
}


=item cmp (a, b)

Compares two intervals.  This is useful for sorting, where you can put { $a->cmp->($b) } as the compare function 

=cut
sub cmp { $_[0]->{low_}->cmp($_[1]->{low_}) }

=back

=head1 NON-OBJECT METHODS

These methods are not object methods, and are exported.  No calling object is expected.

=over 8

=item includes (low, high, num)

This function determins if the number num is contained in the new interval.

Note that you can pass a translated value to this function:

$interval->includes($interval->translate($begin, $end), $val);

=cut
sub includes {
    my ($low, $high, $num) = @_;

    return 1 if($num >= $low && $num <= $high);
    return 0;
}

=item intersection (lowA, highA, lowB, highB)

Find the intersection between the two intervals.  The result is returned in an array, and if there is no intersection, the returned array is empty.

Note that you can pass a translated value to this function:

$interval->includes($interval->translate($begin, $end), $low, $high);

=cut
sub intersection {
    my ($lowA, $highA, $lowB, $highB) = @_;

    my @sorted = sort { $a <=> $b } ($lowA, $highA, $lowB, $highB);
    return () if (($sorted[0] == $lowA && $sorted[1] == $highA) ||
                  ($sorted[0] == $lowB && $sorted[1] == $highB));
    return ($sorted[1], $sorted[2]);
}

sub cmpBoundaryCoords {
    my ($a, $b) = @_;
    my $l;
    if($a =~ /([A-Za-z])/) { $l = $1 }
    if($b =~ /([A-Za-z])/) { 
        my $bl = $1;
        croak "Attempt to match disparate boundary coords $l $bl \n" 
            if(defined($l) && $l ne $bl);
        $l = $bl;
    }
    
    if($a =~ /$l/ && $b !~ /$l/){ return 1; }
    elsif($a !~ /$l/ && $b =~ /$l/){ return -1; }
    elsif($a =~ /$l/ && $b =~ /$l/) {
        #get the L's and spaces out but leave the negative number
        my $re = "[$l ]";
        $a =~ s/$l//g;
        $b =~ s/$l//g;
        #if no digits remain in the string, it was just "L"
        if($a !~ /\d/) {
            if($b !~ /\d/) { return 1   }
            else           { return -1  }
        }
        elsif($b !~ /\d/) { return 1; }
    }
    if($a < $b)                 { return -1; }
    elsif($a > $b)              { return 1;  }
    else                        { return 1;  }
}

=back

=head1 SEE ALSO

=head1 AUTHOR

Bob Zimmermann (rpz@cse.wustl.edu).

=cut

1;
