view release on metacpan or  search on metacpan

lib/Bio/MUST/Core/IdList.pm  view on Meta::CPAN

    return { map { $_->full_id => $i++ }  $self->all_seq_ids };
}

## use critic

after 'add_id' => sub {
    my $self = shift;

    # check if there are indeed ids not yet in private hash
    # Note: this might not be the case when adding ids in an empty list
    my $n = $self->count_ids;
    my $i = $self->count_indices;
    return if $n == $i;

    # update private hash from internal array
    $self->set_index(
             map { $_->full_id => $i++ } ($self->all_seq_ids)[$i..$n-1]
    );
    return;
};


sub all_seq_ids {
    my $self = shift;
    return map { SeqId->new( full_id => $_ ) } $self->all_ids;
}



sub negative_list {
    my $self     = shift;
    my $listable = shift;

    # filter out seq ids that are in the original list
    my @ids = map { $_->full_id } $listable->all_seq_ids;
    return $self->new( ids => [ grep { not $self->is_listed($_) } @ids ] );
}


# IdList-based Ali factory methods


sub reordered_ali {                         ## no critic (RequireArgUnpacking)
    return shift->_ali_from_list_(1, @_);
}



sub filtered_ali {                          ## no critic (RequireArgUnpacking)
    return shift->_ali_from_list_(0, @_);
}


sub _ali_from_list_ {
    my $self    = shift;
    my $reorder = shift;
    my $ali     = shift;
    my $lookup  = shift;        # optional IdList indexing the Ali

    # override passed lookup with internal lookup if available
    # Note: this allows Stash lookups to be used transparently
    $lookup = $ali->lookup if $ali->can('lookup');

    # TODO: warn for missing ids in Ali?

    # create new Ali object (extending header comment)
    # TODO: allow custom comments
    my $new_ali = Ali->new(
        comments => [ $ali->all_comments,
            'built by ' . ($reorder ? 'reordered_ali' : 'filtered_ali')
        ],
    );

    # case 1: use lookup when available
    if (defined $lookup) {
        ### Using lookup...

        # get slot list from lookup
        # Note1: Since this list follows the list in $self it is 'reordered'.
        # We thus sort it by ascending slot if the Ali order must be kept.
        # Note2: We go through SeqId objects to correctly handle MUST ids
        my @ids = map { $_->full_id } $self->all_seq_ids;
        my @slots = $lookup->index_for(@ids);
           @slots = sort { $a <=> $b } @slots unless $reorder;

        # populate new Ali with deep copies of Seqs in slot list
        $new_ali->add_seq( $ali->get_seq($_)->clone ) for @slots;
    }

    # case 2: scan all seqs to find those that are listed
    else {

        SEQ:
        for my $seq ($ali->all_seqs) {
            next SEQ unless $self->is_listed($seq->full_id);

            # add Seq to new Ali honoring either IdList order...
            if ($reorder) {
                $new_ali->set_seq(
                    $self->index_for($seq->full_id), $seq->clone
                );
                next SEQ;
            }

            # ...or original Ali order
            $new_ali->add_seq($seq->clone);
        }

        # when reordering an Ali, ensure that new Ali does not contain
        # empty slots due to some missing ids in the original Ali
        $new_ali->_set_seqs(
            [ $new_ali->filter_seqs( sub { defined } ) ]
        ) if $reorder;
    }

    return $new_ali;
}


# I/O methods