Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Problema con subrutinas

Perl aplicado a la bioinformática
Publicar una respuesta

Problema con subrutinas

Notapor Alfumao » 2010-08-15 09:59 @457

Buenas tardes.

Escribo este post porque tengo un problema invocando subrutinas en un programa.

El problema es que intento hacer un bucle con "foreach" para que procese cada una de las líneas de un fichero de entrada. Supuestamente lo que el programa debe hacer es traducir los 6 marcos de lectura de una secuencia de ADN a Proteína.

El problema es que cuando la entrada consta de más de una secuencia de ADN, a partir de la segunda secuencia de entrada en el bucle, el resultado que obtengo es una adición de los resultados previos...

Supongo que el problema está en que una vez ejecutadas las subrutinas para la primera secuencia. ¿Podría ser que la variable $_ no se reinicia y junta los nuevos resultados con los previos?

Estoy bastante perdido, la verdad...por favor ayudadme ;)

Entrada datos tipo:

Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
ATGGCAAACGCAAAAGCAAGCAGAGTCGATGATGAGGGTACCTAAAAAATTTATTAA
ATGGCAAACGCAAAAGCAAGGGGTACCTTTTATCAACAGAGTCGATGAGTGAGGGTACCTTAAGTTATTAA
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


Aquí os escribo el programa:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/c:/Perl -w
  2.  
  3. %AA3 = (
  4.         'UUU','Phe',
  5.         'UUC','Phe',
  6.         'UUA','Leu',
  7.         'UUG','Leu',
  8.         'UCU','Ser',
  9.         'UCC','Ser',
  10.         'UCA','Ser',
  11.         'UCG','Ser',
  12.         'UAU','Tyr',
  13.         'UAC','Tyr',
  14.         'UAA','***',
  15.         'UAG','***',
  16.         'UGU','Cys',
  17.         'UGC','Cys',
  18.         'UGA','***',
  19.         'UGG','Trp',
  20.        
  21.         'CUU','Leu',
  22.         'CUC','Leu',
  23.         'CUA','Leu',
  24.         'CUG','Leu',
  25.         'CCU','Pro',
  26.         'CCC','Pro',
  27.         'CCA','Pro',
  28.         'CCG','Pro',
  29.         'CAU','His',
  30.         'CAC','His',
  31.         'CAA','Gln',
  32.         'CAG','Gln',
  33.         'CGU','Arg',
  34.         'CGC','Arg',
  35.         'CGA','Arg',
  36.         'CGG','Arg',
  37.  
  38.         'AUU','Ile',
  39.         'AUC','Ile',
  40.         'AUA','Ile',
  41.         'AUG','Met',
  42.         'ACU','Thr',
  43.         'ACC','Thr',
  44.         'ACA','Thr',
  45.         'ACG','Thr',
  46.         'AAU','Asn',
  47.         'AAC','Asn',
  48.         'AAA','Lys',
  49.         'AAG','Lys',
  50.         'AGU','Ser',
  51.         'AGC','Ser',
  52.         'AGA','Arg',
  53.         'AGG','Arg',
  54.        
  55.         'GUU','Val',
  56.         'GUC','Val',
  57.         'GUA','Val',
  58.         'GUG','Val',
  59.         'GCU','Ala',
  60.         'GCC','Ala',
  61.         'GCA','Ala',
  62.         'GCG','Ala',
  63.         'GAU','Asp',
  64.         'GAC','Asp',
  65.         'GAA','Glu',
  66.         'GAG','Glu',
  67.         'GGU','Gly',
  68.         'GGC','Gly',
  69.         'GGA','Gly',
  70.         'GGG','Gly' );
  71.        
  72. %AA1 = (
  73.         'UUU','F  ',
  74.         'UUC','F  ',
  75.         'UUA','L  ',
  76.         'UUG','L  ',
  77.         'UCU','S  ',
  78.         'UCC','S  ',
  79.         'UCA','S  ',
  80.         'UCG','S  ',
  81.         'UAU','Y  ',
  82.         'UAC','Y  ',
  83.         'UAA','*  ',
  84.         'UAG','*  ',
  85.         'UGU','C  ',
  86.         'UGC','C  ',
  87.         'UGA','*  ',
  88.         'UGG','W  ',
  89.        
  90.         'CUU','L  ',
  91.         'CUC','L  ',
  92.         'CUA','L  ',
  93.         'CUG','L  ',
  94.         'CCU','P  ',
  95.         'CCC','P  ',
  96.         'CCA','P  ',
  97.         'CCG','P  ',
  98.         'CAU','H  ',
  99.         'CAC','H  ',
  100.         'CAA','Q  ',
  101.         'CAG','Q  ',
  102.         'CGU','R  ',
  103.         'CGC','R  ',
  104.         'CGA','R  ',
  105.         'CGG','R  ',
  106.  
  107.         'AUU','I  ',
  108.         'AUC','I  ',
  109.         'AUA','I  ',
  110.         'AUG','M  ',
  111.         'ACU','T  ',
  112.         'ACC','T  ',
  113.         'ACA','T  ',
  114.         'ACG','T  ',
  115.         'AAU','N  ',
  116.         'AAC','N  ',
  117.         'AAA','K  ',
  118.         'AAG','K  ',
  119.         'AGU','S  ',
  120.         'AGC','S  ',
  121.         'AGA','R  ',
  122.         'AGG','R  ',
  123.        
  124.         'GUU','V  ',
  125.         'GUC','V  ',
  126.         'GUA','V  ',
  127.         'GUG','V  ',
  128.         'GCU','A  ',
  129.         'GCC','A  ',
  130.         'GCA','A  ',
  131.         'GCG','A  ',
  132.         'GAU','D  ',
  133.         'GAC','D  ',
  134.         'GAA','E  ',
  135.         'GAG','E  ',
  136.         'GGU','G  ',
  137.         'GGC','G  ',
  138.         'GGA','G  ',
  139.         'GGG','G  ' );
  140.  
  141. print "Enter your file name:\n";
  142. chomp($dna = <STDIN>);
  143. open INFILE, "$dna" || die ($!, "Can't open");
  144. @sequence = <INFILE>;
  145.  
  146. open OUTFILE, ">>proteina7.txt" || die ($!, "Can't open");
  147.  
  148. foreach $sequence (@sequence){
  149.    
  150. $sequence = uc $sequence;  # produces the upper case string
  151.  
  152. $sequence =~ s/T/U/g;
  153.  
  154. $no_of_bases = length $sequence;
  155.  
  156. print OUTFILE ("$sequence\n");
  157.  
  158. my $p1 = &Proteina_1;
  159. my $p2 = &Proteina_2;
  160. my $p3 = &Proteina_3;
  161.  
  162.  
  163. $sequence_r = reverse $sequence;
  164. print OUTFILE ("$sequence_r\n\n");
  165.  
  166. my $p1_r = &Proteina_1r;
  167. my $p2_r = &Proteina_2r;
  168. my $p3_r = &Proteina_3r;
  169.  
  170. }
  171. sub Proteina_1 {
  172. for ($i = 0; $i<$no_of_bases; $i=$i+3)
  173.         {
  174.         $codon = substr( $sequence, $i, 3 );
  175.         $amino_acid_sequence_1= $amino_acid_sequence_1 . $AA3{ $codon };
  176.         $amino_acid_sequence_single_1 = $amino_acid_sequence_single_1 . $AA1{ $codon };
  177.         }
  178.  
  179. print OUTFILE ("$amino_acid_sequence_1\n");
  180. print OUTFILE ("$amino_acid_sequence_single_1\n");
  181. }
  182.  
  183. sub Proteina_2 {
  184. for ($i = 1; $i<$no_of_bases; $i=$i+3)
  185.         {
  186.         $codon_2 = substr( $sequence, $i, 3 );
  187.         $amino_acid_sequence_2 = $amino_acid_sequence_2 . $AA3{ $codon_2};
  188.         $amino_acid_sequence_single_2 = $amino_acid_sequence_single_2 . $AA1{ $codon_2};
  189.         }
  190.  
  191. print OUTFILE (" $amino_acid_sequence_2\n");
  192. print OUTFILE (" $amino_acid_sequence_single_2\n");
  193. }
  194.  
  195. sub Proteina_3 {
  196. for ($i = 2 ; $i<$no_of_bases; $i=$i+3)
  197.         {
  198.         $codon_3 = substr( $sequence, $i, 3 );
  199.         $amino_acid_sequence_3 = $amino_acid_sequence_3 . $AA3{ $codon_3};
  200.         $amino_acid_sequence_single_3 = $amino_acid_sequence_single_3 . $AA1{ $codon_3};
  201.         }
  202.  
  203. print OUTFILE ("  $amino_acid_sequence_3\n");
  204. print OUTFILE ("  $amino_acid_sequence_single_3\n\n");
  205. }
  206. sub Proteina_1r {
  207.    
  208. for ($i = 0; $i<$no_of_bases; $i=$i+3)
  209.         {
  210.         $codon_1r = substr( $sequence_r, $i, 3 );
  211.         $amino_acid_sequence_1r= $amino_acid_sequence_1r . $AA3{ $codon_1r};
  212.         $amino_acid_sequence_single_1r = $amino_acid_sequence_single_1r . $AA1{ $codon_1r};
  213.         }
  214.  
  215. print OUTFILE ("$amino_acid_sequence_1r\n");
  216. print OUTFILE ("$amino_acid_sequence_single_1r\n");
  217. }
  218.  
  219. sub Proteina_2r {
  220.  
  221. for ($i = 1; $i<$no_of_bases; $i=$i+3)
  222.         {
  223.         $codon_2r = substr( $sequence_r, $i, 3 );
  224.         $amino_acid_sequence_2r = $amino_acid_sequence_2r . $AA3{ $codon_2r};
  225.         $amino_acid_sequence_single_2r = $amino_acid_sequence_single_2r . $AA1{ $codon_2r};
  226.         }
  227.  
  228. print OUTFILE (" $amino_acid_sequence_2r\n");
  229. print OUTFILE (" $amino_acid_sequence_single_2r\n");
  230. }
  231.  
  232. sub Proteina_3r {
  233.  
  234. for ($i = 2 ; $i<$no_of_bases; $i=$i+3)
  235.         {
  236.         $codon_3r = substr( $sequence_r, $i, 3 );
  237.         $amino_acid_sequence_3r = $amino_acid_sequence_3r . $AA3{ $codon_3r };
  238.         $amino_acid_sequence_single_3r = $amino_acid_sequence_single_3r . $AA1{ $codon_3r };
  239.         }
  240.  
  241. print OUTFILE ("  $amino_acid_sequence_3r\n");
  242. print OUTFILE ("  $amino_acid_sequence_single_3r\n\n");
  243. }
  244.  
  245. __END__
Coloreado en 0.007 segundos, usando GeSHi 1.0.8.4


Salida datos tipo:

Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
AUGGCAAACGCAAAAGCAAGCAGAGUCGAUGAUGAGGGUACCUAAAAAAUUUAUUAA

MetAlaAsnAlaLysAlaSerArgValAspAspGluGlyThr***LysIleTyr***
M  A  N  A  K  A  S  R  V  D  D  E  G  T  *  K  I  Y  *  
 TrpGlnThrGlnLysGlnAlaGluSerMetMetArgValProLysLysPheIle
 W  Q  T  Q  K  Q  A  E  S  M  M  R  V  P  K  K  F  I  
  GlyLysArgLysSerLysGlnSerArg******GlyTyrLeuLysAsnLeuLeu
  G  K  R  K  S  K  Q  S  R  *  *  G  Y  L  K  N  L  L  


AAUUAUUUAAAAAAUCCAUGGGAGUAGUAGCUGAGACGAACGAAAACGCAAACGGUA

LeuPheLysLysSerMetGlyValValAlaGluThrAsnGluAsnAlaAsnGly
L  F  K  K  S  M  G  V  V  A  E  T  N  E  N  A  N  G  
 AsnTyrLeuLysAsnProTrpGlu******LeuArgArgThrLysThrGlnThrVal
 N  Y  L  K  N  P  W  E  *  *  L  R  R  T  K  T  Q  T  V  
  IleIle***LysIleHisGlySerSerSer***AspGluArgLysArgLysArg
  I  I  *  K  I  H  G  S  S  S  *  D  E  R  K  R  K  R  

AUGGCAAACGCAAAAGCAAGGGGUACCUUUUAUCAACAGAGUCGAUGAGUGAGGGUACCUUAAGUUAUUAA
MetAlaAsnAlaLysAlaSerArgValAspAspGluGlyThr***LysIleTyr***MetAlaAsnAlaLysAlaArgGlyThrPheTyrGlnGlnSerArg***ValArgValPro***ValIle
M  A  N  A  K  A  S  R  V  D  D  E  G  T  *  K  I  Y  *  M  A  N  A  K  A  R  G  T  F  Y  Q  Q  S  R  *  V  R  V  P  *  V  I  
 TrpGlnThrGlnLysGlnAlaGluSerMetMetArgValProLysLysPheIleTrpGlnThrGlnLysGlnGlyValProPheIleAsnArgValAspGlu***GlyTyrLeuLysLeuLeu
 W  Q  T  Q  K  Q  A  E  S  M  M  R  V  P  K  K  F  I  W  Q  T  Q  K  Q  G  V  P  F  I  N  R  V  D  E  *  G  Y  L  K  L  L  
  GlyLysArgLysSerLysGlnSerArg******GlyTyrLeuLysAsnLeuLeuGlyLysArgLysSerLysGlyTyrLeuLeuSerThrGluSerMetSerGluGlyThrLeuSerTyr***
  G  K  R  K  S  K  Q  S  R  *  *  G  Y  L  K  N  L  L  G  K  R  K  S  K  G  Y  L  L  S  T  E  S  M  S  E  G  T  L  S  Y  *  

AAUUAUUGAAUUCCAUGGGAGUGAGUAGCUGAGACAACUAUUUUCCAUGGGGAACGAAAACGCAAACGGUA

LeuPheLysLysSerMetGlyValValAlaGluThrAsnGluAsnAlaAsnGlyAsnTyr***IleProTrpGlu***ValAlaGluThrThrIlePheHisGlyGluArgLysArgLysArg
L  F  K  K  S  M  G  V  V  A  E  T  N  E  N  A  N  G  N  Y  *  I  P  W  E  *  V  A  E  T  T  I  F  H  G  E  R  K  R  K  R  
 AsnTyrLeuLysAsnProTrpGlu******LeuArgArgThrLysThrGlnThrValIleIleGluPheHisGlySerGlu***LeuArgGlnLeuPheSerMetGlyAsnGluAsnAlaAsnGly
 N  Y  L  K  N  P  W  E  *  *  L  R  R  T  K  T  Q  T  V  I  I  E  F  H  G  S  E  *  L  R  Q  L  F  S  M  G  N  E  N  A  N  G  
  IleIle***LysIleHisGlySerSerSer***AspGluArgLysArgLysArgLeuLeuAsnSerMetGlyValSerSer***AspAsnTyrPheProTrpGlyThrLysThrGlnThrVal
  I  I  *  K  I  H  G  S  S  S  *  D  E  R  K  R  K  R  L  L  N  S  M  G  V  S  S  *  D  N  Y  F  P  W  G  T  K  T  Q  T  V  
 
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4


Espero que me haya sabido explicar...

Un saludo :?

PD. Siento el barullo de escribir la Entrada y Salida tipo en la ventana del post, pero no me dejaba adjuntar los archivos ".txt"
Alfumao
Perlero nuevo
Perlero nuevo
 
Mensajes: 178
Registrado: 2009-12-10 11:20 @514
Arriba

Publicidad

Re: Problema con subrutinas

Notapor explorer » 2010-08-15 10:58 @498

El problema está en que en las subrutinas estás usando variables globales, que van acumulando los resultados.

Fijémonos en una de ellas:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
sub Proteina_1 {
    for ($i = 0; $i<$no_of_bases; $i=$i+3) {
        $codon = substr( $sequence, $i, 3 );
        $amino_acid_sequence_1 = $amino_acid_sequence_1 . $AA3{ $codon };
        $amino_acid_sequence_single_1 = $amino_acid_sequence_single_1 . $AA1{ $codon };
    }

    print OUTFILE ("$amino_acid_sequence_1\n");
    print OUTFILE ("$amino_acid_sequence_single_1\n");
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Vemos que vas recorriendo la $sequence, en saltos de 3 en 3, para extraer los codones. Los codones son transformados en aminoácidos con la ayuda de los hash, y van almacenándose en las variables $amino_acid_* para luego ser impresas al fichero OUTFILE.

El problema es... que las variables $amino_acid_* NO son reinicializadas en ningún sitio, por lo que siempre van acumulando todos los aminoácidos en las sucesivas llamadas a la subrutina. Y no es eso lo que queremos. Solo queremos que almacenen los aminoácidos correspondientes a una secuencia, solo en una llamada a la subrutina.

Aquí es donde se ve claramente el uso de las variables locales. Reescribimos la subrutina como
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
sub Proteina_1 {
    my $amino_acid_sequence_1;                            # variables locales temporales
    my $amino_acid_sequence_single_1;

    for (my $i = 0; $i < $no_of_bases; $i += 3) {         # recorremos la secuencia
        my $codon = substr( $sequence, $i, 3 );           # codón

        $amino_acid_sequence_1        .= $AA3{ $codon };  # conversión, construcción
        $amino_acid_sequence_single_1 .= $AA1{ $codon };
    }

    print OUTFILE "$amino_acid_sequence_1\n";             # impresión
    print OUTFILE "$amino_acid_sequence_single_1\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

De esta manera, con el operador my(), todas las variables involucradas son locales a la propia subrutina. Su tiempo de vida es exclusivamente dentro de la ejecución de la subrutina, por lo que "desaparecerán" cuando la subrutina termine.

Asunto resuelto.

Es más, ahora podemos simplificar los nombres de las variables:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
sub Proteina_1 {
    my $amino_acid_sequence;                              # variables locales temporales
    my $amino_acid_sequence_single;

    for (my $i = 0; $i < $no_of_bases; $i += 3) {         # recorremos la secuencia
        my $codon = substr( $sequence, $i, 3 );           # codón

        $amino_acid_sequence        .= $AA3{ $codon };    # conversión, construcción
        $amino_acid_sequence_single .= $AA1{ $codon };
    }

    print OUTFILE "$amino_acid_sequence\n";               # impresión
    print OUTFILE "$amino_acid_sequence_single\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Y ahora nos damos cuenta de un detalle... que las tres subrutinas Proteina_X... son la misma... lo único que las diferencia es el punto de lectura del marco y la impresión. Pero eso lo podemos resolver con un argumento a la subrutina.

Si en vez de
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. my $p1 = &Proteina_1;
  2. my $p2 = &Proteina_2;
  3. my $p3 = &Proteina_3;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
escribimos
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. for my $desplazamiento (0 .. 2) {
  2.     Proteina($desplazamiento);
  3. }
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
estaremos llamando a la misma subrutina, pero variando el desplazamiento del marco. Solo queda reescribir la subrutina a algo como
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
sub Proteina {
    my $desplazamiento = shift;                         # leemos el desplazamiento de marco (0..2)
    my $amino_acid_sequence;
    my $amino_acid_sequence_single;

    for (my $i = $desplazamiento; $i < $no_of_bases; $i += 3) {
        my $codon = substr( $sequence, $i, 3 );

        $amino_acid_sequence        .= $AA3{ $codon };
        $amino_acid_sequence_single .= $AA1{ $codon };
    }

    my $espacio = ' ' x $desplazamiento;                # creamos los " " delante de los aminoácidos
    print OUTFILE $espacio . $amino_acid_sequence        . "\n";
    print OUTFILE $espacio . $amino_acid_sequence_single . "\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Problema con subrutinas

Notapor Alfumao » 2010-08-15 18:35 @816

Debería ser algo así entonces...pero no me funciona :?
dice q la variable $codon del hash, usada en las líneas 170, 171, 196 y 197 no se ha inicializado y que se ha utilizado un valor no inicializado en la concatenación (.), de esas mismas líneas...

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/c:/Perl -w
  2. use strict;
  3. my %AA3 = (
  4.         'UUU','Phe',
  5.         'UUC','Phe',
  6.         'UUA','Leu',
  7.         'UUG','Leu',
  8.         'UCU','Ser',
  9.         'UCC','Ser',
  10.         'UCA','Ser',
  11.         'UCG','Ser',
  12.         'UAU','Tyr',
  13.         'UAC','Tyr',
  14.         'UAA','***',
  15.         'UAG','***',
  16.         'UGU','Cys',
  17.         'UGC','Cys',
  18.         'UGA','***',
  19.         'UGG','Trp',
  20.        
  21.         'CUU','Leu',
  22.         'CUC','Leu',
  23.         'CUA','Leu',
  24.         'CUG','Leu',
  25.         'CCU','Pro',
  26.         'CCC','Pro',
  27.         'CCA','Pro',
  28.         'CCG','Pro',
  29.         'CAU','His',
  30.         'CAC','His',
  31.         'CAA','Gln',
  32.         'CAG','Gln',
  33.         'CGU','Arg',
  34.         'CGC','Arg',
  35.         'CGA','Arg',
  36.         'CGG','Arg',
  37.  
  38.         'AUU','Ile',
  39.         'AUC','Ile',
  40.         'AUA','Ile',
  41.         'AUG','Met',
  42.         'ACU','Thr',
  43.         'ACC','Thr',
  44.         'ACA','Thr',
  45.         'ACG','Thr',
  46.         'AAU','Asn',
  47.         'AAC','Asn',
  48.         'AAA','Lys',
  49.         'AAG','Lys',
  50.         'AGU','Ser',
  51.         'AGC','Ser',
  52.         'AGA','Arg',
  53.         'AGG','Arg',
  54.        
  55.         'GUU','Val',
  56.         'GUC','Val',
  57.         'GUA','Val',
  58.         'GUG','Val',
  59.         'GCU','Ala',
  60.         'GCC','Ala',
  61.         'GCA','Ala',
  62.         'GCG','Ala',
  63.         'GAU','Asp',
  64.         'GAC','Asp',
  65.         'GAA','Glu',
  66.         'GAG','Glu',
  67.         'GGU','Gly',
  68.         'GGC','Gly',
  69.         'GGA','Gly',
  70.         'GGG','Gly' );
  71.        
  72. my %AA1 = (
  73.         'UUU','F  ',
  74.         'UUC','F  ',
  75.         'UUA','L  ',
  76.         'UUG','L  ',
  77.         'UCU','S  ',
  78.         'UCC','S  ',
  79.         'UCA','S  ',
  80.         'UCG','S  ',
  81.         'UAU','Y  ',
  82.         'UAC','Y  ',
  83.         'UAA','*  ',
  84.         'UAG','*  ',
  85.         'UGU','C  ',
  86.         'UGC','C  ',
  87.         'UGA','*  ',
  88.         'UGG','W  ',
  89.        
  90.         'CUU','L  ',
  91.         'CUC','L  ',
  92.         'CUA','L  ',
  93.         'CUG','L  ',
  94.         'CCU','P  ',
  95.         'CCC','P  ',
  96.         'CCA','P  ',
  97.         'CCG','P  ',
  98.         'CAU','H  ',
  99.         'CAC','H  ',
  100.         'CAA','Q  ',
  101.         'CAG','Q  ',
  102.         'CGU','R  ',
  103.         'CGC','R  ',
  104.         'CGA','R  ',
  105.         'CGG','R  ',
  106.  
  107.         'AUU','I  ',
  108.         'AUC','I  ',
  109.         'AUA','I  ',
  110.         'AUG','M  ',
  111.         'ACU','T  ',
  112.         'ACC','T  ',
  113.         'ACA','T  ',
  114.         'ACG','T  ',
  115.         'AAU','N  ',
  116.         'AAC','N  ',
  117.         'AAA','K  ',
  118.         'AAG','K  ',
  119.         'AGU','S  ',
  120.         'AGC','S  ',
  121.         'AGA','R  ',
  122.         'AGG','R  ',
  123.        
  124.         'GUU','V  ',
  125.         'GUC','V  ',
  126.         'GUA','V  ',
  127.         'GUG','V  ',
  128.         'GCU','A  ',
  129.         'GCC','A  ',
  130.         'GCA','A  ',
  131.         'GCG','A  ',
  132.         'GAU','D  ',
  133.         'GAC','D  ',
  134.         'GAA','E  ',
  135.         'GAG','E  ',
  136.         'GGU','G  ',
  137.         'GGC','G  ',
  138.         'GGA','G  ',
  139.         'GGG','G  ' );
  140.  
  141. print "Enter your file name:\n";
  142. chomp(my $dna = <STDIN>);
  143. open INFILE, "$dna" || die ($!, "Can't open");
  144. my @sequence = <INFILE>;
  145.  
  146. open OUTFILE, ">>proteina7.txt" || die ($!, "Can't open");
  147.  
  148. foreach my $sequence (@sequence){
  149.    
  150. $sequence = uc $sequence;  # pasamos a mayusculas
  151. $sequence =~ s/T/U/g;
  152.  
  153. my $no_of_bases = length $sequence;
  154.  
  155. print OUTFILE ("$sequence\n");
  156.  
  157. for my $desplazamiento (0 .. 2) {
  158. Proteina($desplazamiento);
  159. }
  160.  
  161. sub Proteina {
  162.     my $desplazamiento = shift;                         # leemos el desplazamiento de marco (0..2)
  163.     my $amino_acid_sequence;
  164.     my $amino_acid_sequence_single;
  165.  
  166.     for (my $i = $desplazamiento; $i < $no_of_bases; $i += 3) {
  167.         my $codon = substr( $sequence, $i, 3 );
  168.  
  169.         my $amino_acid_sequence .= $AA3{ $codon };
  170.         my $amino_acid_sequence_single .= $AA1{ $codon };
  171.     }
  172.  
  173.    
  174.     print OUTFILE ("$amino_acid_sequence \n");
  175.     print OUTFILE ("$amino_acid_sequence_single \n");
  176. }
  177.  
  178. my $sequence_r = reverse $sequence;
  179. print OUTFILE ("$sequence_r\n\n");
  180.  
  181. for my $desplazamiento_r (0 .. 2) {
  182. Proteina_r($desplazamiento_r);
  183. }
  184.  
  185. sub Proteina_r {
  186.     my $desplazamiento_r = shift;                         # leemos el desplazamiento de marco (0..2)
  187.     my $amino_acid_sequence_r;
  188.     my $amino_acid_sequence_single_r;
  189.  
  190.     for (my $i = $desplazamiento_r; $i < $no_of_bases; $i += 3) {
  191.        
  192.         my $codon_r = substr( $sequence_r, $i, 3 );
  193.  
  194.         my $amino_acid_sequence_r .= $AA3{ $codon_r};
  195.         my $amino_acid_sequence_single_r .= $AA1{ $codon_r };
  196.     }
  197.  
  198.    
  199.     print OUTFILE ("$amino_acid_sequence_r \n");
  200.     print OUTFILE ("$amino_acid_sequence_single_r \n");
  201. }
  202. }
Coloreado en 0.007 segundos, usando GeSHi 1.0.8.4
Alfumao
Perlero nuevo
Perlero nuevo
 
Mensajes: 178
Registrado: 2009-12-10 11:20 @514
Arriba

Re: Problema con subrutinas

Notapor explorer » 2010-08-16 03:45 @198

Sí, el problema está en la variable $sequence, que es local al bucle de la línea 148: las subrutinas no saben qué es $sequence.

Si hubieras usado "use strict;" y "use warnings;" desde el principio, Perl te hubiera avisado de estos problemas.

Para pasar información a las subrutinas, tienes dos opciones:

1.- Usar variables globales.
Al principio del programa defines la variable global $secuencia_a_analizar (por ejemplo):
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. my $secuencia_a_analizar;
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

luego, dentro del bucle de la 148, antes de llamar a las subrutinas, asignas a esta variable global el valor de $sequence (por ejemplo, en la 156):
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. $secuencia_a_analizar = $sequence;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

y ahora cambias las subrutinas para que usen $secuencia_a_analizar en lugar de $sequence.

2.- Pasas la secuencia como un argumento más a la función.
Cambias la línea 158 a
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.     Proteina($desplazamiento, $sequence);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
y luego cambias las subrutinas para que lean ese nuevo argumento:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.     my $desplazamiento = shift;                         # leemos el desplazamiento de marco (0..2)
  2.     my $sequence = shift;                               # secuencia a analizar
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.     my $desplazamiento_r = shift;                         # leemos el desplazamiento de marco (0..2)
  2.     my $sequence_r = shift;                               # secuencia a analizar
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Problema con subrutinas

Notapor Alfumao » 2010-08-17 14:52 @661

Muchísimas gracias, Explorer, qué paciencia tienes, que Dios recompense la labor que haces con gente inexperta (o especialmente inepta como es mi caso...)

Al final, la única forma de conseguir un resultado ha sido quitar "use strict;" y usar este código, que, aunque da avisos, me permite obtener el resultado buscado.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/c:/Perl -w
  2.  
  3. my %AA3 = (
  4.         'UUU','Phe',
  5.         'UUC','Phe',
  6.         'UUA','Leu',
  7.         'UUG','Leu',
  8.         'UCU','Ser',
  9.         'UCC','Ser',
  10.         'UCA','Ser',
  11.         'UCG','Ser',
  12.         'UAU','Tyr',
  13.         'UAC','Tyr',
  14.         'UAA','***',
  15.         'UAG','***',
  16.         'UGU','Cys',
  17.         'UGC','Cys',
  18.         'UGA','***',
  19.         'UGG','Trp',
  20.        
  21.         'CUU','Leu',
  22.         'CUC','Leu',
  23.         'CUA','Leu',
  24.         'CUG','Leu',
  25.         'CCU','Pro',
  26.         'CCC','Pro',
  27.         'CCA','Pro',
  28.         'CCG','Pro',
  29.         'CAU','His',
  30.         'CAC','His',
  31.         'CAA','Gln',
  32.         'CAG','Gln',
  33.         'CGU','Arg',
  34.         'CGC','Arg',
  35.         'CGA','Arg',
  36.         'CGG','Arg',
  37.  
  38.         'AUU','Ile',
  39.         'AUC','Ile',
  40.         'AUA','Ile',
  41.         'AUG','Met',
  42.         'ACU','Thr',
  43.         'ACC','Thr',
  44.         'ACA','Thr',
  45.         'ACG','Thr',
  46.         'AAU','Asn',
  47.         'AAC','Asn',
  48.         'AAA','Lys',
  49.         'AAG','Lys',
  50.         'AGU','Ser',
  51.         'AGC','Ser',
  52.         'AGA','Arg',
  53.         'AGG','Arg',
  54.        
  55.         'GUU','Val',
  56.         'GUC','Val',
  57.         'GUA','Val',
  58.         'GUG','Val',
  59.         'GCU','Ala',
  60.         'GCC','Ala',
  61.         'GCA','Ala',
  62.         'GCG','Ala',
  63.         'GAU','Asp',
  64.         'GAC','Asp',
  65.         'GAA','Glu',
  66.         'GAG','Glu',
  67.         'GGU','Gly',
  68.         'GGC','Gly',
  69.         'GGA','Gly',
  70.         'GGG','Gly' );
  71.        
  72. my %AA1 = (
  73.         'UUU','F  ',
  74.         'UUC','F  ',
  75.         'UUA','L  ',
  76.         'UUG','L  ',
  77.         'UCU','S  ',
  78.         'UCC','S  ',
  79.         'UCA','S  ',
  80.         'UCG','S  ',
  81.         'UAU','Y  ',
  82.         'UAC','Y  ',
  83.         'UAA','*  ',
  84.         'UAG','*  ',
  85.         'UGU','C  ',
  86.         'UGC','C  ',
  87.         'UGA','*  ',
  88.         'UGG','W  ',
  89.        
  90.         'CUU','L  ',
  91.         'CUC','L  ',
  92.         'CUA','L  ',
  93.         'CUG','L  ',
  94.         'CCU','P  ',
  95.         'CCC','P  ',
  96.         'CCA','P  ',
  97.         'CCG','P  ',
  98.         'CAU','H  ',
  99.         'CAC','H  ',
  100.         'CAA','Q  ',
  101.         'CAG','Q  ',
  102.         'CGU','R  ',
  103.         'CGC','R  ',
  104.         'CGA','R  ',
  105.         'CGG','R  ',
  106.  
  107.         'AUU','I  ',
  108.         'AUC','I  ',
  109.         'AUA','I  ',
  110.         'AUG','M  ',
  111.         'ACU','T  ',
  112.         'ACC','T  ',
  113.         'ACA','T  ',
  114.         'ACG','T  ',
  115.         'AAU','N  ',
  116.         'AAC','N  ',
  117.         'AAA','K  ',
  118.         'AAG','K  ',
  119.         'AGU','S  ',
  120.         'AGC','S  ',
  121.         'AGA','R  ',
  122.         'AGG','R  ',
  123.        
  124.         'GUU','V  ',
  125.         'GUC','V  ',
  126.         'GUA','V  ',
  127.         'GUG','V  ',
  128.         'GCU','A  ',
  129.         'GCC','A  ',
  130.         'GCA','A  ',
  131.         'GCG','A  ',
  132.         'GAU','D  ',
  133.         'GAC','D  ',
  134.         'GAA','E  ',
  135.         'GAG','E  ',
  136.         'GGU','G  ',
  137.         'GGC','G  ',
  138.         'GGA','G  ',
  139.         'GGG','G  ' );
  140.  
  141. print "Enter your file name:\n";
  142. chomp($dna = <STDIN>);
  143. open INFILE, "$dna" || die ($!, "Can't open");
  144. @sequence = <INFILE>;
  145.  
  146. open OUTFILE, ">>proteinaC6.txt" || die ($!, "Can't open");
  147.  
  148. foreach $sequence (@sequence){
  149.    
  150. $sequence = uc $sequence;  # produces the upper case string
  151.  
  152. $sequence =~ s/T/U/g;
  153.  
  154. $no_of_bases = length $sequence;
  155.  
  156. print OUTFILE ("$sequence\n");
  157.  
  158. my $p1 = &Proteina_1;
  159. my $p2 = &Proteina_2;
  160. my $p3 = &Proteina_3;
  161.  
  162.  
  163. $sequence_r = reverse $sequence;
  164. print OUTFILE ("$sequence_r\n\n");
  165.  
  166. my $p1_r = &Proteina_1r;
  167. my $p2_r = &Proteina_2r;
  168. my $p3_r = &Proteina_3r;
  169.  
  170. }
  171. sub Proteina_1 {
  172.     my $amino_acid_sequence_1;                            # variables locales temporales
  173.     my $amino_acid_sequence_single_1;
  174. for (my $i = 0; $i < $no_of_bases; $i += 3)
  175.         {
  176.         my $codon = substr( $sequence, $i, 3 );
  177.         $amino_acid_sequence_1 .= $AA3{ $codon };
  178.         $amino_acid_sequence_single_1 .=  $AA1{ $codon };
  179.         }
  180.  
  181. print OUTFILE ("$amino_acid_sequence_1\n");
  182. print OUTFILE ("$amino_acid_sequence_single_1\n");
  183. }
  184.  
  185. sub Proteina_2 {
  186.     my $amino_acid_sequence_2;                            # variables locales temporales
  187.     my $amino_acid_sequence_single_2;
  188. for (my $i = 1; $i<$no_of_bases; $i += 3)
  189.         {
  190.         my $codon_2 = substr( $sequence, $i, 3 );
  191.         $amino_acid_sequence_2 .=  $AA3{ $codon_2};
  192.         $amino_acid_sequence_single_2 .=  $AA1{ $codon_2};
  193.         }
  194.  
  195. print OUTFILE (" $amino_acid_sequence_2\n");
  196. print OUTFILE (" $amino_acid_sequence_single_2\n");
  197. }
  198.  
  199. sub Proteina_3 {
  200.     my $amino_acid_sequence_3;                            # variables locales temporales
  201.     my $amino_acid_sequence_single_3;
  202.    
  203. for (my $i = 2 ; $i<$no_of_bases; $i += 3)
  204.         {
  205.         my $codon_3 = substr( $sequence, $i, 3 );
  206.         $amino_acid_sequence_3 .=  $AA3{ $codon_3};
  207.         $amino_acid_sequence_single_3 .=  $AA1{ $codon_3};
  208.         }
  209.  
  210. print OUTFILE ("  $amino_acid_sequence_3\n");
  211. print OUTFILE ("  $amino_acid_sequence_single_3\n\n");
  212. }
  213. sub Proteina_1r {
  214.     my $amino_acid_sequence_1r;                            # variables locales temporales
  215.     my $amino_acid_sequence_single_1r;
  216.    
  217. for (my $i = 0; $i<$no_of_bases; $i += 3)
  218.         {
  219.         my $codon_1r = substr( $sequence_r, $i, 3 );
  220.         $amino_acid_sequence_1r .=  $AA3{ $codon_1r};
  221.         $amino_acid_sequence_single_1r .=  $AA1{ $codon_1r};
  222.         }
  223.  
  224. print OUTFILE ("$amino_acid_sequence_1r\n");
  225. print OUTFILE ("$amino_acid_sequence_single_1r\n");
  226. }
  227.  
  228. sub Proteina_2r {
  229.     my $amino_acid_sequence_2r;                            # variables locales temporales
  230.     my $amino_acid_sequence_single_2r;
  231.  
  232. for (my $i = 1; $i<$no_of_bases; $i += 3)
  233.         {
  234.         my $codon_2r = substr( $sequence_r, $i, 3 );
  235.         $amino_acid_sequence_2r .=  $AA3{ $codon_2r};
  236.         $amino_acid_sequence_single_2r .=  $AA1{ $codon_2r};
  237.         }
  238.  
  239. print OUTFILE (" $amino_acid_sequence_2r\n");
  240. print OUTFILE (" $amino_acid_sequence_single_2r\n");
  241. }
  242.  
  243. sub Proteina_3r {
  244.     my $amino_acid_sequence_3r;                            # variables locales temporales
  245.     my $amino_acid_sequence_single_3r;
  246.    
  247. for (my $i = 2 ; $i<$no_of_bases; $i += 3)
  248.         {
  249.         my $codon_3r = substr( $sequence_r, $i, 3 );
  250.         $amino_acid_sequence_3r .=  $AA3{ $codon_3r };
  251.         $amino_acid_sequence_single_3r .=  $AA1{ $codon_3r };
  252.         }
  253.  
  254. print OUTFILE ("  $amino_acid_sequence_3r\n");
  255. print OUTFILE ("  $amino_acid_sequence_single_3r\n\n");
  256. }
Coloreado en 0.006 segundos, usando GeSHi 1.0.8.4



Un saludo y que mil bendiciones sean contigo y los tuyos ;)
Alfumao
Perlero nuevo
Perlero nuevo
 
Mensajes: 178
Registrado: 2009-12-10 11:20 @514
Arriba

Re: Problema con subrutinas

Notapor explorer » 2010-08-17 15:29 @687

SIEMPRE hay que usar 'use strict;'.

Nos ahorrará mucho tiempo de desarrollo y sorpresas desagradables.

Si lo ponemos en la línea 2, Perl nos dice:
Sintáxis: [ Descargar ] [ Ocultar ]
Using text Syntax Highlighting
Global symbol "$dna" requires explicit package name at code_22852.pl line 142.
Global symbol "$dna" requires explicit package name at code_22852.pl line 143.
Global symbol "@sequence" requires explicit package name at code_22852.pl line 144.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 148.
Global symbol "@sequence" requires explicit package name at code_22852.pl line 148.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 150.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 150.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 152.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 154.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 154.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 156.
Global symbol "$sequence_r" requires explicit package name at code_22852.pl line 163.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 163.
Global symbol "$sequence_r" requires explicit package name at code_22852.pl line 164.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 174.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 176.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 188.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 190.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 203.
Global symbol "$sequence" requires explicit package name at code_22852.pl line 205.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 217.
Global symbol "$sequence_r" requires explicit package name at code_22852.pl line 219.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 232.
Global symbol "$sequence_r" requires explicit package name at code_22852.pl line 234.
Global symbol "$no_of_bases" requires explicit package name at code_22852.pl line 247.
Global symbol "$sequence_r" requires explicit package name at code_22852.pl line 249.
code_22852.pl had compilation errors.
 
Coloreado en 0.000 segundos, usando GeSHi 1.0.8.4

y solo hay que seguir los cambios que nos indica. Hacemos:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. chomp(my $dna = <STDIN>);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. my @sequence = <INFILE>;
  2. my ($no_of_bases, $sequence, $sequence_r);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. foreach my $seq (@sequence){
  2. $sequence = $seq;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

Y ya está.

Actualización. Esta es mi versión:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. #
  3. # Conversión de secuencias de ADN a proteínas,
  4. # mostrando los seis marcos de lecturas posibles.
  5. #
  6. # Joaquín Ferrero. 20100818.
  7. #
  8. # Entradas
  9. #       Ninguna. El programa solicita el nombre del fichero con las secuencias
  10. #       genómicas a traducir.
  11. # Salidas
  12. #       Se crea un fichero con el mismo nombre que el fichero indicado, con la
  13. #       extensión añadida '.c6'.
  14. #
  15.  
  16. use common::sense;                      # activamos Perl Moderno
  17.  
  18. ### Definición de las proteínas ###############################################
  19. my %aminoácidos1 = (
  20.     UUU => 'F',    CUU => 'L',    AUU => 'I',    GUU => 'V',
  21.     UUC => 'F',    CUC => 'L',    AUC => 'I',    GUC => 'V',
  22.     UUA => 'L',    CUA => 'L',    AUA => 'I',    GUA => 'V',
  23.     UUG => 'L',    CUG => 'L',    AUG => 'M',    GUG => 'V',
  24.     UCU => 'S',    CCU => 'P',    ACU => 'T',    GCU => 'A',
  25.     UCC => 'S',    CCC => 'P',    ACC => 'T',    GCC => 'A',
  26.     UCA => 'S',    CCA => 'P',    ACA => 'T',    GCA => 'A',
  27.     UCG => 'S',    CCG => 'P',    ACG => 'T',    GCG => 'A',
  28.     UAU => 'Y',    CAU => 'H',    AAU => 'N',    GAU => 'D',
  29.     UAC => 'Y',    CAC => 'H',    AAC => 'N',    GAC => 'D',
  30.     UAA => '*',    CAA => 'Q',    AAA => 'K',    GAA => 'E',
  31.     UAG => '*',    CAG => 'Q',    AAG => 'K',    GAG => 'E',
  32.     UGU => 'C',    CGU => 'R',    AGU => 'S',    GGU => 'G',
  33.     UGC => 'C',    CGC => 'R',    AGC => 'S',    GGC => 'G',
  34.     UGA => '*',    CGA => 'R',    AGA => 'R',    GGA => 'G',
  35.     UGG => 'W',    CGG => 'R',    AGG => 'R',    GGG => 'G',
  36. );
  37.  
  38. my %aminoácidos3 = (
  39.     UUU => 'Phe',    CUU => 'Leu',    AUU => 'Ile',    GUU => 'Val',
  40.     UUC => 'Phe',    CUC => 'Leu',    AUC => 'Ile',    GUC => 'Val',
  41.     UUA => 'Leu',    CUA => 'Leu',    AUA => 'Ile',    GUA => 'Val',
  42.     UUG => 'Leu',    CUG => 'Leu',    AUG => 'Met',    GUG => 'Val',
  43.     UCU => 'Ser',    CCU => 'Pro',    ACU => 'Thr',    GCU => 'Ala',
  44.     UCC => 'Ser',    CCC => 'Pro',    ACC => 'Thr',    GCC => 'Ala',
  45.     UCA => 'Ser',    CCA => 'Pro',    ACA => 'Thr',    GCA => 'Ala',
  46.     UCG => 'Ser',    CCG => 'Pro',    ACG => 'Thr',    GCG => 'Ala',
  47.     UAU => 'Tyr',    CAU => 'His',    AAU => 'Asn',    GAU => 'Asp',
  48.     UAC => 'Tyr',    CAC => 'His',    AAC => 'Asn',    GAC => 'Asp',
  49.     UAA => '***',    CAA => 'Gln',    AAA => 'Lys',    GAA => 'Glu',
  50.     UAG => '***',    CAG => 'Gln',    AAG => 'Lys',    GAG => 'Glu',
  51.     UGU => 'Cys',    CGU => 'Arg',    AGU => 'Ser',    GGU => 'Gly',
  52.     UGC => 'Cys',    CGC => 'Arg',    AGC => 'Ser',    GGC => 'Gly',
  53.     UGA => '***',    CGA => 'Arg',    AGA => 'Arg',    GGA => 'Gly',
  54.     UGG => 'Trp',    CGG => 'Arg',    AGG => 'Arg',    GGG => 'Gly',
  55. );
  56.  
  57.  
  58. ### Introducción del nombre del fichero a traducir ############################
  59. print 'Entre el nombre del fichero a procesar: ';
  60. my $FICHERO_ADN = <STDIN>;
  61. chomp $FICHERO_ADN;
  62.  
  63. -f $FICHERO_ADN
  64.     or die "ERROR: No puedo acceder al fichero $FICHERO_ADN: $!\n";
  65.  
  66. ### Apertura de ficheros ######################################################
  67. open my $ENTRADA, q[<], $FICHERO_ADN
  68.     or die "ERROR: No puedo leer el fichero $FICHERO_ADN: $!\n";
  69.  
  70. open my $SALIDA, q[>], "$FICHERO_ADN.c6"
  71.     or die "ERROR: No puedo escribir el fichero $FICHERO_ADN.c6: $!\n";
  72.  
  73.  
  74. ### Lectura y procesado #######################################################
  75. while (my $secuencia = <$ENTRADA>) {
  76.  
  77.     chomp $secuencia;
  78.  
  79. #    $secuencia = uc $secuencia;
  80.  
  81.     $secuencia =~ tr/T/U/;
  82.  
  83.     proteínas($secuencia);
  84.  
  85.     $secuencia = reverse $secuencia;
  86.  
  87.     proteínas($secuencia);
  88.  
  89.     print $SALIDA "\n";
  90. }
  91.  
  92. ### Cierre de fichero #########################################################
  93. close $ENTRADA;
  94. close $SALIDA;
  95.  
  96.  
  97. ### Fin #######################################################################
  98. say 'Terminado';
  99.  
  100.  
  101. ### Subrutinas ################################################################
  102. sub proteínas {
  103.     my $secuencia = shift;
  104.  
  105.     say $SALIDA  $secuencia;
  106.  
  107.     for my $offset ( 0 .. 2 ) {
  108.  
  109.         my $secuencia_aminoácidos;
  110.         my $secuencia_aminoácidos_single;
  111.  
  112.         my $seq = substr $secuencia, $offset;
  113.  
  114.         while ($seq =~ m/(...)/g) {                           # por cada codón
  115.             $secuencia_aminoácidos        .= $aminoácidos3{ $1 };   # lo traducimos
  116.             $secuencia_aminoácidos_single .= $aminoácidos1{ $1 } . '  ';
  117.         }
  118.  
  119.         say $SALIDA  q[ ] x $offset  .  $secuencia_aminoácidos;
  120.         say $SALIDA  q[ ] x $offset  .  $secuencia_aminoácidos_single;
  121.     }
  122.  
  123.     print $SALIDA  "\n";
  124. }
  125.  
  126. __END__
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14476
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba
Publicar una respuesta

Volver a Bioinformática

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management
cron