AlignDB-IntSpanXS

 view release on metacpan or  search on metacpan

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

package AlignDB::IntSpanXS;
use strict;
use warnings;

use base qw( DynaLoader );
use Carp;
use Scalar::Util qw(blessed);
use Scalar::Util::Numeric qw(isint);

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

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

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

}

sub sets {
    my $self = shift;

    my @sets;
    my @ranges = $self->ranges;
    while (@ranges) {
        my $lower = shift @ranges;
        my $upper = shift @ranges;
        push @sets, blessed($self)->new("$lower-$upper");
    }

    return @sets;
}

sub runlists {
    my $self = shift;

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

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

    return $slice;
}

sub _splice {
    my $self   = shift;
    my $offset = shift;
    my $length = shift;

    my @edges = $self->edges;
    my $slice = blessed($self)->new;

    while ( @edges > 1 ) {
        my ( $lower, $upper ) = @edges[ 0, 1 ];
        my $span_size = $upper - $lower;

        if ( $offset <= $span_size ) {
            last;
        }
        else {
            splice( @edges, 0, 2 );

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

    my $self     = shift;
    my $code_ref = shift;

    my @sub_elements;
    for ( $self->elements ) {
        if ( $code_ref->() ) {
            push @sub_elements, $_;
        }

    }
    my $sub_set = blessed($self)->new(@sub_elements);

    return $sub_set;
}

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

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

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

    return $map_set;
}

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

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

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

                :               ();
        }
    );

    return $new;
}

sub cover {
    my $self = shift;

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

sub holes {
    my $self = shift;

    my $holes = 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

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

        $holes->add_range(@ranges);
    }

    return $holes;
}

sub inset {
    my $self = shift;
    my $n    = shift;

    my $inset  = blessed($self)->new;
    my @ranges = $self->ranges;
    while (@ranges) {
        my $lower = shift @ranges;
        my $upper = shift @ranges;
        if ( $lower != $self->NEG_INF ) {
            $lower += $n;
        }
        if ( $upper != $self->POS_INF ) {
            $upper -= $n;
        }

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

sub pad {
    my $self = shift;
    my $n    = shift;
    return $self->inset( -$n );
}

sub excise {
    my $self      = shift;
    my $minlength = shift;

    my $set = blessed($self)->new;
    map { $set->merge($_) } grep { $_->size >= $minlength } $self->sets;

    return $set;
}

sub fill {
    my $self      = shift;
    my $maxlength = shift;

    my $set = $self->copy;

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

        confess "Don't know how to deal with input to find_island\n";
    }

    return $island;
}

sub _find_islands_int {
    my $self   = shift;
    my $number = shift;

    my $island = blessed($self)->new;

    # if $pos & 1, i.e. $pos is odd number, $val is in the set
    my $pos = $self->_find_pos( $number + 1, 0 );
    if ( $pos & 1 ) {
        my @ranges = $self->ranges;
        $island->add_range( $ranges[ $pos - 1 ], $ranges[$pos] );
    }

    return $island;
}

sub _find_islands_set {
    my $self     = shift;
    my $supplied = shift;

    my $islands = blessed($self)->new;

    if ( $self->overlap($supplied) ) {
        for my $subset ( $self->sets ) {
            $islands->merge($subset) if $subset->overlap($supplied);
        }
    }

    return $islands;
}

sub nearest_island {
    my $self     = shift;
    my $supplied = shift;

    if ( ref $supplied eq __PACKAGE__ ) {    # just OK
    }
    elsif ( isint($supplied) ) {
        $supplied = blessed($self)->new($supplied);
    }
    else {
        confess "Don't know how to deal with input to nearest_island\n";
    }

    my $island = blessed($self)->new;
    my $min_d;
    for my $s ( $self->sets ) {
        for my $ss ( $supplied->sets ) {
            next if $s->overlap($ss);
            my $d = $s->distance($ss);
            if ( !defined $min_d or $d <= $min_d ) {
                if ( defined $min_d and $d == $min_d ) {
                    $island->merge($s);
                }
                else {

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

# Converts a set specification into a set
sub _real_set {
    my $self     = shift;
    my $supplied = shift;

    if ( defined $supplied and ref $supplied eq __PACKAGE__ ) {
        return $supplied;
    }
    else {
        return blessed($self)->new($supplied);
    }
}

# _find_pos

#----------------------------------------------------------#
# Aliases
#----------------------------------------------------------#

sub runlist      { shift->as_string; }

ppport.h  view on Meta::CPAN

sv_2pvbyte_nolen|5.006000||p
sv_2pvbyte|5.006000||p
sv_2pvutf8_nolen||5.006000|
sv_2pvutf8||5.006000|
sv_2pv|||
sv_2uv_flags||5.009001|
sv_2uv|5.004000||p
sv_add_arena|||
sv_add_backref|||
sv_backoff|||
sv_bless|||
sv_cat_decode||5.008001|
sv_catpv_mg|5.004050||p
sv_catpvf_mg_nocontext|||pvn
sv_catpvf_mg|5.006000|5.004000|pv
sv_catpvf_nocontext|||vn
sv_catpvf||5.004000|v
sv_catpvn_flags||5.007002|
sv_catpvn_mg|5.004050||p
sv_catpvn_nomg|5.007002||p
sv_catpvn|||

t/01.basic.t  view on Meta::CPAN

BEGIN {
    use_ok('AlignDB::IntSpanXS');
}

# Basic hash based set for testing

package TestSet;

sub new {
    return bless {}, shift;
}

sub add {
    my $self = shift;
    $self->{$_} = 1 for @_;
}

sub add_range {
    my $self = shift;
    die unless ( @_ % 2 ) == 0;