view release on metacpan or  search on metacpan

Bio/Assembly/Scaffold.pm  view on Meta::CPAN

    Usage   : $assembly->add_singlet($seq)
    Function: Add a singlet to the assembly
    Returns : 1 on success
    Args    : a Bio::Assembly::Singlet object
              order (optional)

=cut

sub add_singlet {
    my ($self, $singlet) = @_;

    # Input check
    if ( !ref $singlet || ! $singlet->isa('Bio::Assembly::Singlet') ) {
        $self->throw("Bio::Assembly::Scaffold::add_singlet is unable to process".
            " non Bio::Assembly::Singlet object [", ref($singlet), "]");
    }
    
    # Create and attribute singlet ID
    my $singletID = $singlet->id();
    if( !defined $singletID ) {
        $singletID = 'Unknown_' . ($self->get_nof_singlets() + 1);
        $singlet->id($singletID);
        $self->warn("Attributing ID $singletID to unnamed Bio::Assembly::".
            "Singlet object.");
    }
    
    # Adding singlet to scaffold
    $self->warn("Replacing singlet $singletID with a new singlet object")
        if (exists $self->{'_singlets'}{$singletID});
    $self->{'_singlets'}{$singletID} = $singlet;
    $singlet->assembly($self); # weak circular reference

    # Put singlet sequence in the list of sequences belonging to the scaffold
    my $seqID = $singlet->seqref->id();
    if (exists $self->{'_seqs'}{$seqID} &&
        not($self->{'_seqs'}{$seqID} eq $singlet) ) {
        $self->warn( "Sequence $seqID already assigned to object ".
            $self->{'_seqs'}{$seqID}->id().". Moving to singlet $singletID");
    }
    $self->{'_seqs'}{$seqID} = $singlet;

    return 1;
}

=head2 update_seq_list

    Title   : update_seq_list
    Usage   : $assembly->update_seq_list()
    Function: 

              Synchronizes the assembly registry for sequences in
              contigs and contig actual aligned sequences content. You
              probably want to run this after you remove/add a
              sequence from/to a contig in the assembly.

    Returns : 1 for success
    Args    : none 

=cut

sub update_seq_list {
    my $self = shift;
    
    $self->{'_seqs'} = {};

    # Put sequences in contigs in list of sequences belonging to the scaffold
    foreach my $contig ($self->all_contigs) {
        my $contigID = $contig->id();
        foreach my $seqID ($contig->get_seq_ids) {
            if (exists $self->{'_seqs'}{$seqID} &&
                not($self->{'_seqs'}{$seqID} eq $contig) ) {
                $self->warn( "Sequence $seqID already assigned to object ".
                    $self->{'_seqs'}{$seqID}->id().". Moving to contig $contigID");
            }
            $self->{'_seqs'}{$seqID} = $contig;
        }
    }
    
    # Put singlet sequences in the list of sequences belonging to the scaffold
    foreach my $singlet ($self->all_singlets) {
        my $singletID = $singlet->id();
        my $seqID     = $singlet->seqref->id();
        if (exists $self->{'_seqs'}{$seqID} &&
            not($self->{'_seqs'}{$seqID} eq $singlet) ) {
            $self->warn( "Sequence $seqID already assigned to object ".
                $self->{'_seqs'}{$seqID}->id().". Moving to singlet $singletID");
        }
        $self->{'_seqs'}{$seqID} = $singlet;
    }

    return 1;
}

=head2 remove_contigs

    Title   : remove_contigs
    Usage   : $assembly->remove_contigs(1..4)
    Function: Remove contig from assembly object
    Returns : an array of removed Bio::Assembly::Contig
              objects
    Args    : an array of contig IDs 

    See function get_contig_ids() above

=cut

sub remove_contigs {
    my ($self, @args) = @_;

    my @ret = ();
    foreach my $contigID (@args) {
        foreach my $seqID ($self->get_contig_by_id($contigID)->get_seq_ids()) {
            delete $self->{'_seqs'}{$seqID};
        }
        push(@ret, $self->{'_contigs'}{$contigID});
        delete $self->{'_contigs'}{$contigID};
    }

    return @ret;
}