view release on metacpan or  search on metacpan

lib/Bio/Gonzales/Domain/Identification/HMMER/SeqMarks.pm  view on Meta::CPAN

    my @imarks;
    push @imarks, shift @marks;

    #merge intervals
    for my $m (@marks) {
        if ( $imarks[-1]->{to} > $m->{from} ) {
            $imarks[-1]->{to} = $m->{to}
                if ( $m->{to} > $imarks[-1]->{to} );
        } else {
            push @imarks, $m;
        }
    }

    #invert
    my $start = $self->boundaries->[0] - 1;
    my @iimarks;
    for my $m (@imarks) {
        next if($start == $m->{from});
        push @iimarks, { from => $start + 1, to => $m->{from} - 1, hit => 1 }
            unless ( $m->{from} == $start + 1 );
        $start = $m->{to};
    }

    push @iimarks, { from => $start + 1, to => $self->boundaries->[1], hit => 1 }
        unless ( $start == $self->boundaries->[1] );

    return \@iimarks;
}

sub _to_boundaries {
    my ( $self, $from, $to ) = @_;

    $to = $self->boundaries->[1]
        if ( $to > $self->boundaries->[1] || $from > $to );

    $from = $self->boundaries->[0]
        if ( $from < $self->boundaries->[0] || $from > $to );

    return ( $from, $to );
}

around 'mark_names' => sub {
    my $orig = shift;
    my $self = shift;

    if ( @_ > 0 ) {
        my ($names) = @_;

        croak 'mark names not equal to number of marks'
            if ( @{$names} != $self->num_marks );
        my %names;
        for ( my $i = 0; $i < @{$names}; $i++ ) {
            $names{ $names->[$i] } = $i;
        }
        return $self->$orig( \%names );
    } else {
        return $self->$orig;
    }
};

sub update_mark {
    my ( $self, $mark, $from, $to ) = @_;

    $mark = $self->mark_from_name($mark)
        unless ( $mark =~ /^\d+$/ );

    $self->marks->[$mark]->{from} = $from
        if ( $self->marks->[$mark] > $from );

    $self->marks->[$mark]->{to} = $to
        if ( $self->marks->[$mark]->{to} < $to );
    $self->marks->[$mark]->{hit} = 1;
}

sub num_marks_hit {
    my ($self) = @_;

    return scalar grep { exists $_->{hit} } @{ $self->marks };
}

sub hit_in_every_mark {
    my ($self) = @_;

    return $self->num_marks_hit == $self->num_marks;
}

sub clear_extend {
    my ($self) = @_;
    $self->_clear_extension;
}

sub extend {
    my ( $self, $left, $right ) = @_;

    croak 'you have to supply parameters'
        unless ($left);
    $right = $left
        unless ($right);

    $self->_extension( [ $left, $right ] );
    return $self;
}

sub reset_extend {
    my ($self) = @_;

    $self->_clearer_extension;

    return $self;
}

sub spanning_region {
    my ($self) = @_;

    my ( $min, $max ) = ( INT_MAX, INT_MIN );

    for my $m ( @{ $self->marks } ) {
        $min = $m->{from}
            if ( $m->{from} < $min );

        $max = $m->{to}