#!/usr/bin/perl -w

# Ejercicio 8. Abre el fichero dna1.txt, lee la cadena de ADN,

# extrae codones y lo convierte en aminoacidos.

open (CADENA_DNA, "dna1.txt") or die "No se puede abrir el fichero dna1.txt\n";

$cadena_unida= '';

# Lee el fichero

@texto = <CADENA_DNA>;

$cadena_proteina = '';

close (CADENA_DNA);

# Leemos las lineas del fichero a partir de la sexta.

# Dividimos cada linea en palabras y eliminamos la 1ª que contiene sólo números.

# Unimos cada una de estas palabras para formar unacadena con todas las bases.

#

for ($i = 5; $i<scalar @texto; $i++) {

@palabras = split(' ',$texto[$i]);

# El indice $j empieza a contar en 1 porque $palabra[0] contendrá numeros

# que no nos interesan.

for ($j = 1; $j < scalar @palabras; $j++) {

$cadena_unida = $cadena_unida.$palabras[$j];

}

}

# Cuenta de cada una de las bases

#________________________________

@dna =();

@dna = split ('', $cadena_unida);

$cont_A = 0;

$cont_C = 0;

$cont_T = 0;

$cont_G = 0;

$base ='';

foreach $base (@dna) {

if ($base eq 'a') {$cont_A++;}

elsif ($base eq 'c') {$cont_C++;}

elsif ($base eq 't') {$cont_T++;}

else {$cont_G++;}

}

print "Hay $cont_A As \n";

print "Hay $cont_C Cs \n";

print "Hay $cont_G Gs \n";

print "Hay $cont_T Ts \n";

#________________________________

# Conversión de codones en aminoácidos

#________________________________

# Leemos la cadena $cadena_unida, extrayendo los codones mediante la función substr

# que permite extraer trozos de una cadena, del tamaño que queramos, y a partir de la

# posición que queramos.

for ($i=0; $i < (length($cadena_unida)-2); $i += 3) {

$codon = substr($cadena_unida,$i,3);

$cadena_proteina = $cadena_proteina.codon2aa($codon);

}

print "La cadena de proteinas es: \n $cadena_proteina \n";

#________________________________

# Guardarlo en el fichero amino.txt

#________________________________

open(AMINO, ">amino.txt");

print AMINO $cadena_proteina;

close (AMINO);

#________________________________

# Cuenta de cada uno de los aminoácidos

#________________________________

# Dividimos la cadena de proteinas en sus letras componentes.

@proteina = split ('', $cadena_proteina);

# Vamos a crear un array asociativo llamado %prot, que inicialmente estará vacío

# y que iremos llenando usando como clave el nombre del aminoacido y

# como valor el número de veces que aparece.

%prot = ();

for ($i=0; $i < scalar @proteina; $i++) {

if (exists($prot{$proteina[$i]})) {

$prot{$proteina[$i]}++;

}

else {

$prot{$proteina[$i]} = 1;

}

}

# Vamos a imprimir los resultados

foreach $clav (keys %prot)

{

print "Hay $prot{$clav} de tipo $clav\n";

}

# Solicita al usuario unporcentaje e imprime los nombres de los aminoacidos por encima

# de ese porcentaje.

print "\n\n\n Introduce un numero entre 0 y 100:\n";

$porcentaje = <STDIN>;

chomp $porcentaje;

# $total guarda el numero total de aminoacidos en la cadena

$total = $#proteina;

foreach $clav (keys %prot)

{

$porc = (100*$prot{$clav})/$total;

if ($porc > $porcentaje) {

print "\n La $clav supera el porcentaje del $porcentaje %";

}

}

#________________________________

#

# codon2aa Subrutina tomada del libro "Beginning PERL for bioinformatics", J. Tisdall.

#

# A subroutine to translate a DNA 3-character codon to an amino acid

# Version 3, using hash lookup

sub codon2aa {

my($codon) = @_;

$codon = uc $codon;

my(%genetic_code) = (

'TCA' => 'S', # Serine

'TCC' => 'S', # Serine

'TCG' => 'S', # Serine

'TCT' => 'S', # Serine

'TTC' => 'F', # Phenylalanine

'TTT' => 'F', # Phenylalanine

'TTA' => 'L', # Leucine

'TTG' => 'L', # Leucine

'TAC' => 'Y', # Tyrosine

'TAT' => 'Y', # Tyrosine

'TAA' => '_', # Stop

'TAG' => '_', # Stop

'TGC' => 'C', # Cysteine

'TGT' => 'C', # Cysteine

'TGA' => '_', # Stop

'TGG' => 'W', # Tryptophan

'CTA' => 'L', # Leucine

'CTC' => 'L', # Leucine

'CTG' => 'L', # Leucine

'CTT' => 'L', # Leucine

'CCA' => 'P', # Proline

'CCC' => 'P', # Proline

'CCG' => 'P', # Proline

'CCT' => 'P', # Proline

'CAC' => 'H', # Histidine

'CAT' => 'H', # Histidine

'CAA' => 'Q', # Glutamine

'CAG' => 'Q', # Glutamine

'CGA' => 'R', # Arginine

'CGC' => 'R', # Arginine

'CGG' => 'R', # Arginine

'CGT' => 'R', # Arginine

'ATA' => 'I', # Isoleucine

'ATC' => 'I', # Isoleucine

'ATT' => 'I', # Isoleucine

'ATG' => 'M', # Methionine

'ACA' => 'T', # Threonine

'ACC' => 'T', # Threonine

'ACG' => 'T', # Threonine

'ACT' => 'T', # Threonine

'AAC' => 'N', # Asparagine

'AAT' => 'N', # Asparagine

'AAA' => 'K', # Lysine

'AAG' => 'K', # Lysine

'AGC' => 'S', # Serine

'AGT' => 'S', # Serine

'AGA' => 'R', # Arginine

'AGG' => 'R', # Arginine

'GTA' => 'V', # Valine

'GTC' => 'V', # Valine

'GTG' => 'V', # Valine

'GTT' => 'V', # Valine

'GCA' => 'A', # Alanine

'GCC' => 'A', # Alanine

'GCG' => 'A', # Alanine

'GCT' => 'A', # Alanine

'GAC' => 'D', # Aspartic Acid

'GAT' => 'D', # Aspartic Acid

'GAA' => 'E', # Glutamic Acid

'GAG' => 'E', # Glutamic Acid

'GGA' => 'G', # Glycine

'GGC' => 'G', # Glycine

'GGG' => 'G', # Glycine

'GGT' => 'G', # Glycine

);

if(exists $genetic_code{$codon}) {

return $genetic_code{$codon};

}else{

print STDERR "Bad codon \"$codon\"!!\n";

exit;

}

}

exit;