Raw content of Bio::Seq::EncodedSeq # $Id: EncodedSeq.pm,v 1.5.2.1 2003/04/28 12:11:57 jason Exp $ # # BioPerl module for Bio::Seq::EncodedSeq # # Cared for by Aaron Mackey # # Copyright Aaron Mackey # # You may distribute this module under the same terms as perl itself # POD documentation - main docs before the code =head1 NAME Bio::Seq::EncodedSeq - subtype of L<Bio::LocatableSeq|Bio::LocatableSeq> to store DNA that encodes a protein =head1 SYNOPSIS $obj = new Bio::Seq::EncodedSeq(-seq => $dna, -encoding => "CCCCCCCIIIIICCCCC", -start => 1, -strand => 1, -length => 17); # splice out (and possibly revcomp) the coding sequence $cds = obj->cds; # obtain the protein translation of the sequence $prot = $obj->translate; # other access/inspection routines as with Bio::LocatableSeq and # Bio::SeqI; note that coordinates are relative only to the DNA # sequence, not it's implicit encoded protein sequence. =head1 DESCRIPTION Bio::Seq::EncodedSeq is a L<Bio::LocatableSeq|Bio::LocatableSeq> object that holds a DNA sequence as well as information about the coding potential of that DNA sequence. It is meant to be useful in an alignment context, where the DNA may contain frameshifts, gaps and/or introns, or in describing the transcript of a gene. An EncodedSeq provides the ability to access the "spliced" coding sequence, meaning that all introns and gaps are removed, and any frameshifts are adjusted to provide a "clean" CDS. In order to make simultaneous use of either the DNA or the implicit encoded protein sequence coordinates, please see L<Bio::Coordinate::EncodingPair>. =head1 ENCODING We use the term "encoding" here to refer to the series of symbols that we use to identify which residues of a DNA sequence are protein-coding (i.e. part of a codon), intronic, part of a 5' or 3', frameshift "mutations", etc. From this information, a Bio::Seq::EncodedSeq is able to "figure out" its translational CDS. There are two sets of coding characters, one termed "implicit" and one termed "explicit". The "implict" encoding is a bit simpler than the "explicit" encoding: 'C' is used for any nucleotide that's part of a codon, 'U' for any UTR, etc. The full list is shown below: Code Meaning ---- ------- C coding I intronic U untranslated G gapped (for use in alignments) F a "forward", +1 frameshift B a "backward", -1 frameshift The "explicit" encoding is just an expansion of the "implicit" encoding, to denote phase: Code Meaning ---- ------- C coding, 1st codon position D coding, 2nd codon position E coding, 3rd codon position I intronic, phase 0 (relative to intron begin) J intronic, phase 1 K intronic, phase 2 U untranslated 3'UTR V untranslated 5'UTR G gapped (for use in alignments) F a "forward", +1 frameshift B a "backward", -1 frameshift Note that the explicit coding is meant to provide easy access to position/phase specific nucleotides: $obj = new Bio::Seq::EncodedSeq (-seq => "ACAATCAGACTACG...", -encoding => "CCCCCCIII..." ); # fetch arrays of nucleotides at each codon position: my @pos1 = $obj->dnaseq(encoding => 'C', explicit => 1); my @pos2 = $obj->dnaseq(encoding => 'D'); my @pos3 = $obj->dnaseq(encoding => 'E'); # fetch arrays of "3-1" codon dinucleotides, useful for genomic # signature analyses without compounding influences of codon bias: my @pairs = $obj->dnaseq(encoding => 'EC'); =head1 FEEDBACK =head2 Mailing Lists User feedback is an integral part of the evolution of this and other Bioperl modules. Send your comments and suggestions preferably to one of the Bioperl mailing lists. Your participation is much appreciated. bioperl-l@bioperl.org - General discussion http://www.bioperl.org/MailList.html - About the mailing lists =head2 Reporting Bugs Report bugs to the Bioperl bug tracking system to help us keep track the bugs and their resolution. Bug reports can be submitted via email or the web: bioperl-bugs@bio.perl.org http://bugzilla.bioperl.org/ =head1 AUTHOR - Aaron Mackey Email amackey@virginia.edu =head1 APPENDIX The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _ =cut # Let the code begin... package Bio::Seq::EncodedSeq; use strict; use vars qw(@ISA); use Bio::LocatableSeq; @ISA = qw(Bio::LocatableSeq); =head2 new Title : new Usage : $obj = Bio::Seq::EncodedSeq->new(-seq => "AGTACGTGTCATG", -encoding => "CCCCCCFCCCCCC", -id => "myseq", -start => 1, -end => 13, -strand => 1 ); Function: creates a new Bio::Seq::EncodedSeq object from a supplied DNA sequence Returns : a new Bio::Seq::EncodedSeq object Args : seq - primary nucleotide sequence used to encode the protein; note that any positions involved in a gap ('G') or backward frameshift ('B') should have one or more gap characters; if the encoding specifies G or B, but no (or not enough) gap characters exist, *they'll be added*; similary, if there are gap characters without a corresponding G or B encoding, G's will be inserted into the encoding. This allows some flexibility in specifying your sequence and coding without having to calculate a lot of the encoding for yourself. encoding - a string of characters (see Encoding Table) describing backwards frameshifts implied by the encoding but not present in the sequence will be added (as '-'s) to the sequence. If not supplied, it will be assumed that all positions are coding (C). Encoding may include either implicit phase encoding characters (i.e. "CCC") and/or explicit encoding characters (i.e. "CDE"). Additionally, prefixed numbers may be used to denote repetition (i.e. "27C3I28C"). Alternatively, encoding may be a hashref datastructure, with encoding characters as keys and Bio::LocationI objects (or arrayrefs of Bio::LocationI objects) as values, e.g.: { C => [ Bio::Location::Simple->new(1,9), Bio::Location::Simple->new(11,13) ], F => Bio::Location::Simple->new(10,10), } # same as "CCCCCCCCCFCCC" Note that if the location ranges overlap, the behavior of the encoding will be undefined (well, it will be defined, but only according to the order in which the hash keys are read, which is basically undefined ... just don't do that). id, start, end, strand - as with Bio::LocatableSeq; note that the coordinates are relative to the encoding DNA sequence, not the implicit protein sequence. If strand is reversed, then the encoding is assumed to be relative to the reverse strand as well. =cut #' sub new { my ($self, @args) = @_; $self = $self->SUPER::new(@args, -alphabet => 'dna'); my ($enc) = $self->_rearrange([qw(ENCODING)], @args); # set the real encoding: if ($enc) { $self->encoding($enc); } else { $self->_recheck_encoding; } return $self; } =head2 encoding Title : encoding Usage : $obj->encoding("CCCCCC"); $obj->encoding( -encoding => { I => $location } ); $enc = $obj->encoding(-explicit => 1); $enc = $obj->encoding("CCCCCC", -explicit => 1); $enc = $obj->encoding(-location => $location, -explicit => 1, -absolute => 1 ); Function: get/set the objects encoding, either globally or by location(s). Returns : the (possibly new) encoding string. Args : encoding - see the encoding argument to the new() function. explicit - whether or not to return explicit phase information in the coding (i.e. "CCC" becomes "CDE", "III" becomes "IJK", etc); defaults to 0. location - optional; location to get/set the encoding. Defaults to the entire sequence. absolute - whether or not the locational elements (either in the encoding hashref or the location argument) are relative to the absolute start/end of the Bio::LocatableSeq, or to the internal, relative coordinate system (beginning at 1); defaults to 0 (i.e. relative) =cut sub encoding { my ($self, @args) = @_; my ($enc, $loc, $exp, $abs) = $self->_rearrange([qw(ENCODING LOCATION EXPLICIT ABSOLUTE)], @args); if (!$enc) { # do nothing; _recheck_encoding will fix for us, if necessary } elsif (ref $enc eq 'HASH') { $self->throw( -class => 'Bio::Root::NotImplemented', -text => "Hashref functionality not yet implemented;\nplease email me if you really need this."); #TODO: finish all this while (my ($char, $locs) = each %$enc) { if (ref $locs eq 'ARRAY') { } elsif (UNIVERSAL::isa($locs, "Bio::LocationI")) { } else { $self->throw("Only a scalar or a ref to a hash; not a ref to a @{{lc ref $enc}}"); } } } elsif (! ref $enc) { $enc = uc $enc; $exp = 1 if (!defined $exp && $enc =~ m/[DEJKV]/o); if ($enc =~ m/\d/o) { # numerically "enhanced" encoding my $numenc = $enc; $enc = ''; while ($numenc =~ m/\G(\d*)([CDEIJKUVGFB])/g) { my ($num, $char) = ($1, $2); $num = 1 unless $num; $enc .= $char x $num; } } if (defined $exp && $exp == 0 && $enc =~ m/([^CIUGFB])/) { $self->throw("Unrecognized character '$1' in implicit encoding"); } elsif ($enc =~ m/[^CDEIJKUVGFB]/) { $self->throw("Unrecognized character '$1' in explicit encoding"); } if ($loc) { # a global location, over which to apply the specified encoding. # balk if too many non-gap characters present in encoding: my ($ct) = $enc =~ tr/GB/GB/; $ct = length($enc) - $ct; $self->throw("Location length doesn't match number of coding chars in encoding!") if ($loc->location_type eq 'EXACT' && $loc->length != $ct); my $start = $loc->start; my $end = $loc->end; # strip any encoding that hangs off the ends of the sequence: if ($start < $self->start) { my $diff = $self->start - $start; $start = $self->start; $enc = substr($enc, $diff); } if ($end > $self->end) { my $diff = $end - $self->end; $end = $self->end; $enc = substr($enc, -$diff); } my $currenc = $self->{_encoding}; my $currseq = $self->seq; my ($spanstart, $spanend) = ($self->column_from_residue_number($start), $self->column_from_residue_number($end) ); if ($currseq) { # strip any gaps in sequence spanned by this location: my ($before, $in, $after) = $currseq =~ m/(.{@{[ $spanstart - ($loc->location_type eq 'IN-BETWEEN' ? 0 : 1) ]}}) (.{@{[ $spanend - $spanstart + ($loc->location_type eq 'IN-BETWEEN' ? -1 : 1) ]}}) (.*) /x; $in =~ s/[\.\-]+//g; $currseq = $before . $in . $after; # change seq without changing the alphabet $self->seq($currseq,$self->alphabet()); } $currenc = reverse $currenc if $self->strand < 0; substr($currenc, $spanstart, $spanend - $spanstart + ($loc->location_type eq 'IN-BETWEEN' ? -1 : 1), $self->strand >= 0 ? $enc : reverse $enc); $currenc = reverse $currenc if $self->strand < 0; $self->{_encoding} = $currenc; $self->_recheck_encoding; $currenc = $self->{_encoding}; $currenc = reverse $currenc if $self->strand < 0; $enc = substr($currenc, $spanstart, length $enc); $enc = reverse $enc if $self->strand < 0; return $exp ? $enc: $self->_convert2implicit($enc); } else { # presume a global redefinition; strip any current gap # characters in the sequence so they don't corrupt the # encoding my $dna = $self->seq; $dna =~ s/[\.\-]//g; $self->seq($dna, 'dna'); $self->{_encoding} = $enc; } } else { $self->throw("Only a scalar or a ref to a hash; not a ref to a @{{lc ref $enc}}"); } $self->_recheck_encoding(); return $exp ? $self->{_encoding} : $self->_convert2implicit($self->{_encoding}); } sub _convert2implicit { my ($self, $enc) = @_; $enc =~ s/[DE]/C/g; $enc =~ s/[JK]/I/g; $enc =~ s/V/U/g; return $enc; } sub _recheck_encoding { my $self = shift; my @enc = split //, ($self->{_encoding} || ''); my @nt = split(//, $self->SUPER::seq); @nt = reverse @nt if $self->strand && $self->strand < 0; # make sure an encoding exists! @enc = ('C') x scalar grep { !/[\.\-]/o } @nt unless @enc; # check for gaps to be truly present in the sequence # and vice versa my $i; for ($i = 0 ; $i < @nt && $i < @enc ; $i++) { if ($nt[$i] =~ /[\.\-]/o && $enc[$i] !~ m/[GB]/o) { splice(@enc, $i, 0, 'G'); } elsif ($nt[$i] !~ /[\.\-]/o && $enc[$i] =~ m/[GB]/o) { splice(@nt, $i, 0, '-'); } } if ($i < @enc) { # extra encoding; presumably all gaps? for ( ; $i < @enc ; $i++) { if ($enc[$i] =~ m/[GB]/o) { push @nt, '-'; } else { $self->throw("Extraneous encoding info: " . join('', @enc[$i..$#enc])); } } } elsif ($i < @nt) { for ( ; $i < @nt ; $i++) { if ($nt[$i] =~ m/[\.\-]/o) { push @enc, 'G'; } else { push @enc, 'C'; } } } my @cde_array = qw(C D E); my @ijk_array = qw(I J K); # convert any leftover implicit coding into explicit coding my ($Cct, $Ict, $Uct, $Vct, $Vwarned) = (0, 0, 0, 0); for ($i = 0 ; $i < @enc ; $i++) { if ($enc[$i] =~ m/[CDE]/o) { my $temp_index = $Cct %3; $enc[$i] = $cde_array[$temp_index]; $Cct++; $Ict = 0; $Uct = 1; $self->warn("3' untranslated encoding (V) seen prior to other coding symbols") if ($Vct && !$Vwarned++); } elsif ($enc[$i] =~ m/[IJK]/o) { $enc[$i] = $ijk_array[$Ict % 3]; $Ict++; $Uct = 1; $self->warn("3' untranslated encoding (V) seen before other coding symbols") if ($Vct && !$Vwarned++); } elsif ($enc[$i] =~ m/[UV]/o) { if ($Uct == 1) { $enc[$i] = 'V'; $Vct = 1; } } elsif ($enc[$i] eq 'B') { $Cct++; $Ict++ } elsif ($enc[$i] eq 'G') { # gap; leave alone } } @nt = reverse @nt if $self->strand && $self->strand < 0; $self->{'seq'} = join('', @nt); # $self->seq(join('', @nt), 'dna'); $self->{_encoding} = join '', @enc; } =head2 cds Title : cds Usage : $cds = $obj->cds(-nogaps => 1); Function: obtain the "spliced" DNA sequence, by removing any nucleotides that participate in an UTR, forward frameshift or intron, and replacing any unknown nucleotide implied by a backward frameshift or gap with N's. Returns : a Bio::Seq::EncodedSeq object, with an encoding consisting only of "CCCC..". Args : nogaps - strip any gap characters (resulting from 'G' or 'B' encodings), rather than replacing them with N's. =cut sub cds { my ($self, @args) = @_; my ($nogaps, $loc) = $self->_rearrange([qw(NOGAPS LOCATION)], @args); $nogaps = 0 unless defined $nogaps; my @nt = split //, $self->strand < 0 ? $self->revcom->seq : $self->seq; my @enc = split //, $self->_convert2implicit($self->{_encoding}); my ($start, $end) = (0, scalar @nt); if ($loc) { $start = $loc->start; $start++ if $loc->location_type eq 'IN-BETWEEN'; $start = $self->column_from_residue_number($start); $start--; $end = $loc->end; $end = $self->column_from_residue_number($end); ($start, $end) = ($end, $start) if $self->strand < 0; $start--; } for (my $i = $start ; $i < $end ; $i++) { if ($enc[$i] eq 'I' || $enc[$i] eq 'U' || $enc[$i] eq 'F') { # remove introns, untranslated and forward frameshift nucleotides $nt[$i] = undef; } elsif ($enc[$i] eq 'G' || $enc[$i] eq 'B') { # replace gaps and backward frameshifts with N's, unless asked not to. $nt[$i] = $nogaps ? undef : 'N'; } } return ($self->can_call_new ? ref($self) : __PACKAGE__)->new (-seq => join('', grep { defined } @nt[$start..--$end]), -start => $self->start, -end => $self->end, -strand => 1, -alphabet => 'dna'); } =head2 translate Title : translate Usage : $prot = $obj->translate(@args); Function: obtain the protein sequence encoded by the underlying DNA sequence; same as $obj->cds()->translate(@args). Returns : a Bio::PrimarySeq object. Args : same as the translate() function of Bio::PrimarySeqI =cut sub translate { shift->cds(-nogaps => 1, @_)->SUPER::translate(@_) }; =head2 protseq Title : seq Usage : $protseq = $obj->protseq(); Function: obtain the raw protein sequence encoded by the underlying DNA sequence; This is the same as calling $obj->translate()->seq(); Returns : a string of single-letter amino acid codes Args : same as the seq() function of Bio::PrimarySeq; note that this function may not be used to set the protein sequence; see the dnaseq() function for that. =cut sub protseq { shift->cds(-nogaps => 1, @_)->SUPER::translate(@_)->seq }; =head2 dnaseq Title : dnaseq Usage : $dnaseq = $obj->dnaseq(); $obj->dnaseq("ACGTGTCGT", "CCCCCCCCC"); $obj->dnaseq(-seq => "ATG", -encoding => "CCC", -location => $loc ); @introns = $obj->$dnaseq(-encoding => 'I') Function: get/set the underlying DNA sequence; will overwrite any current DNA and/or encoding information present. Returns : a string of single-letter nucleotide codes, including any gaps implied by the encoding. Args : seq - the DNA sequence to be used as a replacement encoding - the encoding of the DNA sequence (see the new() constructor); defaults to all 'C' if setting a new DNA sequence. If no new DNA sequence is being provided, then the encoding is used as a "filter" for which to return fragments of non-overlapping DNA that match the encoding. location - optional, the location of the DNA sequence to get/set; defaults to the entire sequence. =cut sub dnaseq { my ($self, @args) = @_; my ($seq, $enc, $loc) = $self->_rearrange([qw(DNASEQ ENCODING LOCATION)], @args); $self } # need to overload this so that we truncate both the seq and the encoding! sub trunc { my ($self, $start, $end) = @_; my $new = $self->SUPER::trunc($start, $end); $start--; my $enc = $self->{_encoding}; $enc = reverse $enc if $self->strand < 0; $enc = substr($enc, $start, $end - $start); $enc = reverse $enc if $self->strand < 0; $new->encoding($enc); return $new; }