File Coverage

blib/lib/Bio/JBrowse/Store/NCList/NCList.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	13	14	92.8
condition			n/a
subroutine	8	8	100.0
pod	1	4	25.0
total	63	67	94.0

#After
#Alekseyenko, A., and Lee, C. (2007).
#Nested Containment List (NCList): A new algorithm for accelerating
#   interval query of genome alignment and interval databases.
#Bioinformatics, doi:10.1093/bioinformatics/btl647
#http://bioinformatics.oxfordjournals.org/cgi/content/abstract/btl647v1

package Bio::JBrowse::Store::NCList::NCList;
BEGIN {
  $Bio::JBrowse::Store::NCList::NCList::AUTHORITY = 'cpan:RBUELS';
}
{
  $Bio::JBrowse::Store::NCList::NCList::VERSION = '0.1';
}

use strict;
use warnings;
use List::Util qw(max);


sub new {
    my ($class, $start, $end, $setSublist, $featList) = @_;

    my @features = sort {
        $start->($a) <=> $start->($b) || $end->($b) <=> $end->($a)
    } @$featList;

    #@sublistStack is a list of all the currently relevant sublists
    #(one for each level of nesting)
    my @sublistStack;
    #$curlist is the currently active sublist
    my $curList = [];

    my $self = { 'topList'    => $curList,
                 'setSublist' => $setSublist,
                 'count'      => scalar( @features ),
                 'minStart'   => ( @features ? $start->($features[0]) : undef ),
               };
    bless $self, $class;

    push @$curList, $features[0] if @features;

    my $maxEnd = @features ? $end->($features[0]) : undef;

    my $topSublist;
    for (my $i = 1; $i < @features; $i++) {
        $maxEnd = max( $maxEnd, $end->( $features[$i] ));
        #if this interval is contained in the previous interval,
        if ($end->($features[$i]) < $end->($features[$i - 1])) {
            #create a new sublist starting with this interval
            push @sublistStack, $curList;
            $curList = [$features[$i]];
            $setSublist->($features[$i - 1], $curList);
        } else {
            #find the right sublist for this interval
            while (1) {
                #if we're at the top level list,
                if ($#sublistStack < 0) {
                    #just add the current feature
                    push @$curList, $features[$i];
                    last;
                } else {
                    $topSublist = $sublistStack[$#sublistStack];
                    #if the last interval in the top sublist ends
                    #after the end of the current interval,
                    if ($end->($topSublist->[$#{$topSublist}])
                        > $end->($features[$i]) ) {
                        #then curList is the first (deepest) sublist
                        #that the current feature fits into, and
                        #we add the current feature to curList
                        push @$curList, $features[$i];
                        last;
                    } else {
                        #move on to the next shallower sublist
                        $curList = pop @sublistStack;
                    }
                }
            }
        }
    }

    $self->{maxEnd} = $maxEnd;

    return $self;
}

sub maxEnd {
    return shift->{maxEnd};
}

sub minStart {
    return shift->{minStart};
}

sub nestedList {
    return shift->{topList};
}

1;

__END__