AlignDB-IntSpan

 view release on metacpan or  search on metacpan

lib/AlignDB/IntSpan.pm  view on Meta::CPAN

package AlignDB::IntSpan;
use strict;
use warnings;

use Carp;
use Scalar::Util;
use Scalar::Util::Numeric;

use overload (
    q{0+}   => sub { Carp::confess "Can't numerify an AlignDB::IntSpan\n" },
    q{bool} => q{is_not_empty},
    q{""}   => q{as_string},

    # use Perl standard behaviours for other operations
    fallback => 1,
);

our $VERSION = '1.1.1';

my $POS_INF = 2_147_483_647 - 1;             # INT_MAX - 1
my $NEG_INF = ( -2_147_483_647 - 1 ) + 1;    # INT_MIN + 1

sub POS_INF {
    return $POS_INF - 1;
}

sub NEG_INF {
    return $NEG_INF;
}

sub EMPTY_STRING {
    return '-';
}

sub new {
    my $class = shift;
    my $self  = {};
    $self->{edges} = [];
    bless $self, $class;
    $self->add(@_) if @_ > 0;
    return $self;
}

sub valid {
    my $this    = shift;
    my $runlist = shift;

    my $class = ref($this) || $this;
    my $set = new $class;

    eval { $set->_runlist_to_ranges($runlist) };
    return $@ ? 0 : 1;
}

sub clear {
    my $self = shift;
    $self->{edges} = [];
    return $self;
}

sub edges_ref {
    my $self = shift;
    return $self->{edges};
}

sub edges {
    my $self = shift;
    return @{ $self->edges_ref };
}

sub edge_size {

lib/AlignDB/IntSpan.pm  view on Meta::CPAN

    my @sets;
    my @edges = $self->edges;
    while (@edges) {
        my $lower = shift @edges;
        my $upper = shift(@edges) - 1;
        push @sets, Scalar::Util::blessed($self)->new("$lower-$upper");
    }

    if (@sets) {
        return @sets;
    }
    else {
        return;
    }
}

sub runlists {
    my $self = shift;

    if ( $self->is_empty ) {
        return $self->EMPTY_STRING;
    }

    my @runlists;
    my @edges = $self->edges;
    while (@edges) {
        my $lower  = shift @edges;
        my $upper  = shift(@edges) - 1;
        my $string = $lower == $upper ? $lower : $lower . '-' . $upper;
        push @runlists, $string;
    }

    if (@runlists) {
        return @runlists;
    }
    else {
        return;
    }
}

sub cardinality {
    my $self = shift;

    my $cardinality = 0;
    my @edges       = $self->edges;
    while (@edges) {
        my $lower = shift @edges;
        my $upper = shift(@edges) - 1;
        $cardinality += $upper - $lower + 1;
    }

    return $cardinality;
}

sub is_empty {
    my $self = shift;
    my $result = $self->edge_size == 0 ? 1 : 0;
    return $result;
}

sub is_not_empty {
    my $self = shift;
    return !$self->is_empty;
}

sub is_neg_inf {
    my $self = shift;
    return $self->edges_ref->[0] == $NEG_INF;
}

sub is_pos_inf {
    my $self = shift;
    return $self->edges_ref->[-1] == $POS_INF;
}

sub is_infinite {
    my $self = shift;
    return $self->is_neg_inf || $self->is_pos_inf;
}

sub is_finite {
    my $self = shift;
    return !$self->is_infinite;
}

sub is_universal {
    my $self = shift;
    return $self->edge_size == 2 && $self->is_neg_inf && $self->is_pos_inf;
}

sub contains_all {
    my $self = shift;

    for my $i (@_) {
        my $pos = $self->_find_pos( $i + 1, 0 );
        return 0 unless $pos & 1;
    }

    return 1;
}

sub contains_any {
    my $self = shift;

    for my $i (@_) {
        my $pos = $self->_find_pos( $i + 1, 0 );
        return 1 if $pos & 1;
    }

    return 0;
}

#@returns AlignDB::IntSpan
sub add_pair {
    my $self   = shift;
    my @ranges = @_;

    if ( scalar(@ranges) != 2 ) {
        Carp::confess "Number of ranges must be two: @ranges\n";
    }

lib/AlignDB/IntSpan.pm  view on Meta::CPAN

sub map_set {
    my $self     = shift;
    my $code_ref = shift;

    my @map_elements;
    for ( $self->elements ) {
        for my $element ( $code_ref->() ) {
            if ( defined $element ) {
                push @map_elements, $element;
            }
        }

    }
    my $map_set = Scalar::Util::blessed($self)->new(@map_elements);

    return $map_set;
}

sub substr_span {
    my $self   = shift;
    my $string = shift;

    my $sub_string = "";
    my @spans      = $self->spans;

    for (@spans) {
        my ( $lower, $upper ) = @$_;
        my $length = $upper - $lower + 1;

        $sub_string .= substr( $string, $lower - 1, $length );
    }

    return $sub_string;
}

#@returns AlignDB::IntSpan
sub banish_span {
    my $self  = shift;
    my $start = shift;
    my $end   = shift;

    my $remove_length = $end - $start + 1;

    my $new = $self->map_set(
        sub {
                  $_ < $start ? $_
                : $_ > $end   ? $_ - $remove_length
                :               ();
        }
    );

    return $new;
}

#@returns AlignDB::IntSpan
sub cover {
    my $self = shift;

    my $cover = Scalar::Util::blessed($self)->new;
    if ( $self->is_not_empty ) {
        $cover->add_pair( $self->min, $self->max );
    }
    return $cover;
}

#@returns AlignDB::IntSpan
sub holes {
    my $self = shift;

    my $holes = Scalar::Util::blessed($self)->new;

    if ( $self->is_empty or $self->is_universal ) {

        # empty set and universal set have no holes
    }
    else {
        my $c_set  = $self->complement;
        my @ranges = $c_set->ranges;

        # Remove infinite arms of complement set
        if ( $c_set->is_neg_inf ) {
            shift @ranges;
            shift @ranges;
        }
        if ( $c_set->is_pos_inf ) {
            pop @ranges;
            pop @ranges;
        }
        $holes->add_range(@ranges);
    }

    return $holes;
}

#@returns AlignDB::IntSpan
sub inset {
    my $self = shift;
    my $n    = shift;

    my $inset = Scalar::Util::blessed($self)->new;
    my @edges = $self->edges;
    while (@edges) {
        my $lower = shift @edges;
        my $upper = shift(@edges) - 1;
        if ( $lower != $self->NEG_INF ) {
            $lower += $n;
        }
        if ( $upper != $self->POS_INF ) {
            $upper -= $n;
        }
        $inset->add_pair( $lower, $upper )
            if $lower <= $upper;
    }

    return $inset;
}

#@returns AlignDB::IntSpan
sub trim {
    my $self = shift;

lib/AlignDB/IntSpan.pm  view on Meta::CPAN

=head2 B<INTERFACE: Set contents>

=head2 edges_ref

Return the internal used ArrayRef representing the set.

I don't think you should use this method.

=head2 edges

Return the internal used Array representing the set.

I don't think you should use this method.

=head2 edge_size

Return the number of edges

=head2 span_size

Return the number of spans

=head2 as_string

Return a string representation of the set.

=head2 as_array

Return an array containing all the members of the set in ascending order.

=head2 B<INTERFACE: Span contents>

=head2 ranges

Returns the runs in $set, as a list of ($lower, $upper)

=head2 spans

Returns the runs in $set, as a list of [$lower, $upper]

=head2 sets

Returns the runs in $set, as a list of AlignDB::IntSpan objects. The sets in
the list are in order.

=head2 runlists

Returns the runs in $set, as a list of "$lower-$upper"

=head2 B<INTERFACE: Set cardinality>

=head2 cardinality

Returns the number of elements in $set.

=head2 is_empty

Return true if the set is empty.

=head2 is_not_empty

Return true if the set is not empty.

=head2 is_neg_inf

Return true if the set is negtive infinite.

=head2 is_pos_inf

Return true if the set is positive infinite.

=head2 is_infinite

Return true if the set is infinite.

=head2 is_finite

Return true if the set is finite.

=head2 is_universal

Return true if the set contains all integers.

=head2 B<INTERFACE: Membership test>

=head2 contains_all

Return true if the set contains all of the specified numbers.

=head2 contains_any

Return true if the set contains any of the specified numbers.

=head2 B<INTERFACE: Member operations>

=head2 add_pair

    $set->add_pair($lower, $upper);

Add a pair of inclusive integers to the set.

A pair of arguments constitute a range

=head2 add_range

    $set->add_range($lower, $upper);

Add the inclusive range of integers to the set.

Multiple ranges may be specified. Each pair of arguments constitute a range

=head2 add_runlist

    $set->add_runlist($runlist);

Add the specified runlist to the set.

=head2 add

    $set->add($number1, $number2, $number3 ...)