AlignDB-Codon

 view release on metacpan or  search on metacpan

lib/AlignDB/Codon.pm  view on Meta::CPAN


# lookup hash of all pairwise combinations of codons differing by 1
#    1 = synonymous, 0 = non-synonymous, -1 = stop
has 'syn_changes' => ( is => 'ro', isa => 'HashRef', );

# One <=> Three
has 'one2three' => ( is => 'ro', isa => 'HashRef', );
has 'three2one' => ( is => 'ro', isa => 'HashRef', );

sub BUILD {
    my $self = shift;

    $self->_make_codons;
    $self->change_codon_table( $self->{table_id} );
    $self->_load_aa_code;

    return;
}

sub _make_codons {
    my $self = shift;

    # makes all codon combinations
    my @nucs = qw(T C A G);
    my @codons;
    for my $i (@nucs) {
        for my $j (@nucs) {
            for my $k (@nucs) {
                push @codons, "$i$j$k";
            }
        }
    }
    $self->{codons} = \@codons;

    my %codon_idx;
    for my $i ( 0 .. $#codons ) {
        $codon_idx{ $codons[$i] } = $i;
    }
    $self->{codon_idx} = \%codon_idx;

    return;
}

sub change_codon_table {
    my $self = shift;
    my $id   = shift;

    my @NAMES = (    #id
        'Strict',                      # 0, special option for ATG-only start
        'Standard',                    # 1
        'Vertebrate Mitochondrial',    # 2
        'Yeast Mitochondrial',         # 3
        'Mold, Protozoan, and Coelenterate Mitochondrial and Mycoplasma/Spiroplasma',    # 4
        'Invertebrate Mitochondrial',                                                    # 5
        'Ciliate, Dasycladacean and Hexamita Nuclear',                                   # 6
        '', '',
        'Echinoderm and Flatworm Mitochondrial',                                         # 9
        'Euplotid Nuclear',                                                              # 10
        'Bacterial, Archaeal and Plant Plastid',                                         # 11
        'Alternative Yeast Nuclear',                                                     # 12
        'Ascidian Mitochondrial',                                                        # 13
        'Alternative Flatworm Mitochondrial',                                            # 14
        'Blepharisma Nuclear',                                                           # 15
        'Chlorophycean Mitochondrial',                                                   # 16
        '', '', '', '',
        'Trematode Mitochondrial',                                                       # 21
        'Scenedesmus obliquus Mitochondrial',                                            # 22
        'Thraustochytrium Mitochondrial',                                                # 23
        'Pterobranchia Mitochondrial',                                                   # 24
        'Candidate Division SR1 and Gracilibacteria',                                    # 25
    );

    my @TABLES = qw(
        FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSS**VVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWTTTTPPPPHHQQRRRRIIMMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSSSSVVVVAAAADDEEGGGG
        FFLLSSSSYYQQCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        '' ''
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNNKSSSSVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCCWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CC*WLLLSPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSSGGVVVVAAAADDEEGGGG
        FFLLSSSSYYY*CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNNKSSSSVVVVAAAADDEEGGGG
        FFLLSSSSYY*QCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY*LCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        '' '' '' ''
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNNKSSSSVVVVAAAADDEEGGGG
        FFLLSS*SYY*LCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FF*LSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSSKVVVVAAAADDEEGGGG
        FFLLSSSSYY**CCGWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
    );

    my @STARTS = qw(
        -----------------------------------M----------------------------
        ---M---------------M---------------M----------------------------
        --------------------------------MMMM---------------M------------
        ----------------------------------MM----------------------------
        --MM---------------M------------MMMM---------------M------------
        ---M----------------------------MMMM---------------M------------
        -----------------------------------M----------------------------
        '' ''
        -----------------------------------M---------------M------------
        -----------------------------------M----------------------------
        ---M---------------M------------MMMM---------------M------------
        -------------------M---------------M----------------------------
        ---M------------------------------MM---------------M------------
        -----------------------------------M----------------------------
        -----------------------------------M----------------------------
        -----------------------------------M----------------------------
        '' ''  '' ''
        -----------------------------------M---------------M------------
        -----------------------------------M----------------------------
        --------------------------------M--M---------------M------------
        ---M---------------M---------------M---------------M------------
        ---M-------------------------------M---------------M------------
    );

lib/AlignDB/Codon.pm  view on Meta::CPAN

    my $peptide    = "";
    my $codon2aa   = $self->codon2aa;
    my $codon_size = 3;
    for ( my $i = 0; $i < ( length($seq) - ( $codon_size - 1 ) ); $i += $codon_size ) {
        my $triplet = substr( $seq, $i, $codon_size );
        if ( exists $codon2aa->{$triplet} ) {
            $peptide .= $codon2aa->{$triplet};
        }
        else {
            $peptide .= 'X';
        }
    }
    return $peptide;
}

sub is_start_codon {
    my $self = shift;
    my $cod  = shift;

    $cod = uc $cod;
    $cod =~ tr/U/T/;

    my $table_starts = $self->table_starts;
    my $codon_idx    = $self->codon_idx;

    if ( exists $codon_idx->{$cod} ) {
        my $aa = substr( $table_starts, $codon_idx->{$cod}, 1 );
        return $aa eq "M" ? 1 : 0;
    }
    else {
        return 0;
    }
}

sub is_ter_codon {
    my $self = shift;
    my $cod  = shift;

    $cod = uc $cod;
    $cod =~ tr/U/T/;

    my $table_content = $self->table_content;
    my $codon_idx     = $self->codon_idx;

    if ( exists $codon_idx->{$cod} ) {
        my $aa = substr( $table_content, $codon_idx->{$cod}, 1 );
        return $aa eq "*" ? 1 : 0;
    }
    else {
        return 0;
    }
}

sub _load_aa_code {
    my $self = shift;

    my %one2three = (
        A   => 'Ala',    # Alanine
        R   => 'Arg',    # Arginine
        N   => 'Asn',    # Asparagine
        D   => 'Asp',    # Aspartic acid
        C   => 'Cys',    # Cysteine
        Q   => 'Gln',    # Glutamine
        E   => 'Glu',    # Glutamic acid
        G   => 'Gly',    # Glycine
        H   => 'His',    # Histidine
        I   => 'Ile',    # Isoleucine
        L   => 'Leu',    # Leucine
        K   => 'Lys',    # Lysine
        M   => 'Met',    # Methionine
        F   => 'Phe',    # Phenylalanine
        P   => 'Pro',    # Proline
        S   => 'Ser',    # Serine
        T   => 'Thr',    # Threonine
        W   => 'Trp',    # Tryptophan
        Y   => 'Tyr',    # Tyrosine
        V   => 'Val',    # Valine
        B   => 'Asx',    # Aspartic acid or Asparagine
        Z   => 'Glx',    # Glutamine or Glutamic acid
        X   => 'Xaa',    # Any or unknown amino acid
        '*' => '***',    # Stop codon
    );
    my %three2one = reverse(%one2three);

    $self->{one2three} = \%one2three;
    $self->{three2one} = \%three2one;

    return;
}

sub convert_123 {
    my $self    = shift;
    my $peptide = shift;

    $peptide = uc $peptide;
    my $three_of = $self->one2three;

    my $converted;
    for my $pos ( 0 .. length($peptide) - 1 ) {
        my $aa_code = substr( $peptide, $pos, 1 );
        if ( $three_of->{$aa_code} ) {
            $converted .= $three_of->{$aa_code};
        }
        else {
            Carp::confess "Wrong single-letter amino acid code [$aa_code]!\n";
            $converted .= ' ' x 3;
        }
    }
    return $converted;
}

sub convert_321 {
    my $self    = shift;
    my $peptide = shift;

    $peptide = lc $peptide;
    my $one_of = $self->three2one;

    my $converted;
    for ( my $pos = 0; $pos < length($peptide); $pos += 3 ) {
        my $aa_code = substr( $peptide, $pos, 3 );
        $aa_code = ucfirst $aa_code;
        if ( $one_of->{$aa_code} ) {
            $converted .= $one_of->{$aa_code};
        }
        else {
            warn "Wrong three-letter amino acid code [$aa_code]!\n";
            $converted .= ' ' x 3;
        }

    }

    return $converted;
}

1;    # Magic true value required at end of module

__END__

=pod

=encoding UTF-8

=head1 NAME

AlignDB::Codon - translate sequences and calculate Dn/Ds

=head1 DESCRIPTION

AlignDB::Codon provides methods to translate sequences and calculate Dn/Ds with different codon
tables.

Some parts of this module are extracted from BioPerl to avoid the huge number of its dependencies.

=head1 METHODS

=head2 change_codon_table

    $obj->change_codon_table(2);

Change used codon table and recalc all attributes.

Codon table id should be in range of 1-6,9-16,21.

=head2 comp_codons

    my ($syn, $nsy) = $obj->comp_codons('TTT', 'GTA');

    my ($syn, $nsy) = $obj->comp_codons('TTT', 'GTA', 1);

Compares 2 codons to find the number of synonymous and non-synonymous mutations between them.

If the third parameter (in 0 .. 2) is given, this method will return syn&nsy at this position.

=head2 is_start_codon

    my $bool = $obj->is_start_codon('ATG')

Returns true for codons that can be used as a translation start, false for others.

=head2 is_ter_codon

    my $bool = $obj->is_ter_codon('GAA')

Returns true for codons that can be used as a translation terminator, false for others.

=head2 convert_123



( run in 0.828 second using v1.01-cache-2.11-cpan-df04353d9ac )