Foro - Perl en Español

por **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

ATGGCAAACGCAAAAGCAAGGGGTACCTTTTATCAACAGAGTCGATGAGTGAGGGTACCTTAAGTTATTAAColoreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Aquí os escribo el programa:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/c:/Perl -w
 
%AA3 = ( 
        'UUU','Phe',
        'UUC','Phe',
        'UUA','Leu',
        'UUG','Leu',
        'UCU','Ser',
        'UCC','Ser',
        'UCA','Ser',
        'UCG','Ser',
        'UAU','Tyr',
        'UAC','Tyr',
        'UAA','***',
        'UAG','***',
        'UGU','Cys',
        'UGC','Cys',
        'UGA','***',
        'UGG','Trp',
        
        'CUU','Leu',
        'CUC','Leu',
        'CUA','Leu',
        'CUG','Leu',
        'CCU','Pro',
        'CCC','Pro',
        'CCA','Pro',
        'CCG','Pro',
        'CAU','His',
        'CAC','His',
        'CAA','Gln',
        'CAG','Gln',
        'CGU','Arg',
        'CGC','Arg',
        'CGA','Arg',
        'CGG','Arg',
 
        'AUU','Ile',
        'AUC','Ile',
        'AUA','Ile',
        'AUG','Met',
        'ACU','Thr',
        'ACC','Thr',
        'ACA','Thr',
        'ACG','Thr',
        'AAU','Asn',
        'AAC','Asn',
        'AAA','Lys',
        'AAG','Lys',
        'AGU','Ser',
        'AGC','Ser',
        'AGA','Arg',
        'AGG','Arg',
        
        'GUU','Val',
        'GUC','Val',
        'GUA','Val',
        'GUG','Val',
        'GCU','Ala',
        'GCC','Ala',
        'GCA','Ala',
        'GCG','Ala',
        'GAU','Asp',
        'GAC','Asp',
        'GAA','Glu',
        'GAG','Glu',
        'GGU','Gly',
        'GGC','Gly',
        'GGA','Gly',
        'GGG','Gly' );
        
%AA1 = ( 
        'UUU','F  ',
        'UUC','F  ',
        'UUA','L  ',
        'UUG','L  ',
        'UCU','S  ',
        'UCC','S  ',
        'UCA','S  ',
        'UCG','S  ',
        'UAU','Y  ',
        'UAC','Y  ',
        'UAA','*  ',
        'UAG','*  ',
        'UGU','C  ',
        'UGC','C  ',
        'UGA','*  ',
        'UGG','W  ',
        
        'CUU','L  ',
        'CUC','L  ',
        'CUA','L  ',
        'CUG','L  ',
        'CCU','P  ',
        'CCC','P  ',
        'CCA','P  ',
        'CCG','P  ',
        'CAU','H  ',
        'CAC','H  ',
        'CAA','Q  ',
        'CAG','Q  ',
        'CGU','R  ',
        'CGC','R  ',
        'CGA','R  ',
        'CGG','R  ',
 
        'AUU','I  ',
        'AUC','I  ',
        'AUA','I  ',
        'AUG','M  ',
        'ACU','T  ',
        'ACC','T  ',
        'ACA','T  ',
        'ACG','T  ',
        'AAU','N  ',
        'AAC','N  ',
        'AAA','K  ',
        'AAG','K  ',
        'AGU','S  ',
        'AGC','S  ',
        'AGA','R  ',
        'AGG','R  ',
        
        'GUU','V  ',
        'GUC','V  ',
        'GUA','V  ',
        'GUG','V  ',
        'GCU','A  ',
        'GCC','A  ',
        'GCA','A  ',
        'GCG','A  ',
        'GAU','D  ',
        'GAC','D  ',
        'GAA','E  ',
        'GAG','E  ',
        'GGU','G  ',
        'GGC','G  ',
        'GGA','G  ',
        'GGG','G  ' );
 
print "Enter your file name:\n";
chomp($dna = <STDIN>);
open INFILE, "$dna" || die ($!, "Can't open");
@sequence = <INFILE>;
 
open OUTFILE, ">>proteina7.txt" || die ($!, "Can't open");
 
foreach $sequence (@sequence){
    
$sequence = uc $sequence;  # produces the upper case string
 
$sequence =~ s/T/U/g;
 
$no_of_bases = length $sequence;
 
print OUTFILE ("$sequence\n");
 
my $p1 = &Proteina_1;
my $p2 = &Proteina_2;
my $p3 = &Proteina_3;
 
 
$sequence_r = reverse $sequence;
print OUTFILE ("$sequence_r\n\n");
 
my $p1_r = &Proteina_1r;
my $p2_r = &Proteina_2r;
my $p3_r = &Proteina_3r;
 
}
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");
}
 
sub Proteina_2 {
for ($i = 1; $i<$no_of_bases; $i=$i+3)
        {
        $codon_2 = substr( $sequence, $i, 3 );
        $amino_acid_sequence_2 = $amino_acid_sequence_2 . $AA3{ $codon_2};
        $amino_acid_sequence_single_2 = $amino_acid_sequence_single_2 . $AA1{ $codon_2};
        }
 
print OUTFILE (" $amino_acid_sequence_2\n");
print OUTFILE (" $amino_acid_sequence_single_2\n");
}
 
sub Proteina_3 {
for ($i = 2 ; $i<$no_of_bases; $i=$i+3)
        {
        $codon_3 = substr( $sequence, $i, 3 );
        $amino_acid_sequence_3 = $amino_acid_sequence_3 . $AA3{ $codon_3};
        $amino_acid_sequence_single_3 = $amino_acid_sequence_single_3 . $AA1{ $codon_3};
        }
 
print OUTFILE ("  $amino_acid_sequence_3\n");
print OUTFILE ("  $amino_acid_sequence_single_3\n\n");
}
sub Proteina_1r {
   
for ($i = 0; $i<$no_of_bases; $i=$i+3)
        {
        $codon_1r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_1r= $amino_acid_sequence_1r . $AA3{ $codon_1r};
        $amino_acid_sequence_single_1r = $amino_acid_sequence_single_1r . $AA1{ $codon_1r};
        }
 
print OUTFILE ("$amino_acid_sequence_1r\n");
print OUTFILE ("$amino_acid_sequence_single_1r\n");
}
 
sub Proteina_2r {
 
for ($i = 1; $i<$no_of_bases; $i=$i+3)
        {
        $codon_2r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_2r = $amino_acid_sequence_2r . $AA3{ $codon_2r};
        $amino_acid_sequence_single_2r = $amino_acid_sequence_single_2r . $AA1{ $codon_2r};
        }
 
print OUTFILE (" $amino_acid_sequence_2r\n");
print OUTFILE (" $amino_acid_sequence_single_2r\n");
}
 
sub Proteina_3r {
  
for ($i = 2 ; $i<$no_of_bases; $i=$i+3)
        {
        $codon_3r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_3r = $amino_acid_sequence_3r . $AA3{ $codon_3r };
        $amino_acid_sequence_single_3r = $amino_acid_sequence_single_3r . $AA1{ $codon_3r };
        }
 
print OUTFILE ("  $amino_acid_sequence_3r\n");
print OUTFILE ("  $amino_acid_sequence_single_3r\n\n");
}
 
__END__
Coloreado en 0.008 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"

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

my $p1 = &Proteina_1;
my $p2 = &Proteina_2;
my $p3 = &Proteina_3;
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

escribimos

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

for my $desplazamiento (0 .. 2) {
    Proteina($desplazamiento);
}
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

por **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

#!/c:/Perl -w
use strict;
my %AA3 = ( 
        'UUU','Phe',
        'UUC','Phe',
        'UUA','Leu',
        'UUG','Leu',
        'UCU','Ser',
        'UCC','Ser',
        'UCA','Ser',
        'UCG','Ser',
        'UAU','Tyr',
        'UAC','Tyr',
        'UAA','***',
        'UAG','***',
        'UGU','Cys',
        'UGC','Cys',
        'UGA','***',
        'UGG','Trp',
        
        'CUU','Leu',
        'CUC','Leu',
        'CUA','Leu',
        'CUG','Leu',
        'CCU','Pro',
        'CCC','Pro',
        'CCA','Pro',
        'CCG','Pro',
        'CAU','His',
        'CAC','His',
        'CAA','Gln',
        'CAG','Gln',
        'CGU','Arg',
        'CGC','Arg',
        'CGA','Arg',
        'CGG','Arg',
 
        'AUU','Ile',
        'AUC','Ile',
        'AUA','Ile',
        'AUG','Met',
        'ACU','Thr',
        'ACC','Thr',
        'ACA','Thr',
        'ACG','Thr',
        'AAU','Asn',
        'AAC','Asn',
        'AAA','Lys',
        'AAG','Lys',
        'AGU','Ser',
        'AGC','Ser',
        'AGA','Arg',
        'AGG','Arg',
        
        'GUU','Val',
        'GUC','Val',
        'GUA','Val',
        'GUG','Val',
        'GCU','Ala',
        'GCC','Ala',
        'GCA','Ala',
        'GCG','Ala',
        'GAU','Asp',
        'GAC','Asp',
        'GAA','Glu',
        'GAG','Glu',
        'GGU','Gly',
        'GGC','Gly',
        'GGA','Gly',
        'GGG','Gly' );
        
my %AA1 = ( 
        'UUU','F  ',
        'UUC','F  ',
        'UUA','L  ',
        'UUG','L  ',
        'UCU','S  ',
        'UCC','S  ',
        'UCA','S  ',
        'UCG','S  ',
        'UAU','Y  ',
        'UAC','Y  ',
        'UAA','*  ',
        'UAG','*  ',
        'UGU','C  ',
        'UGC','C  ',
        'UGA','*  ',
        'UGG','W  ',
        
        'CUU','L  ',
        'CUC','L  ',
        'CUA','L  ',
        'CUG','L  ',
        'CCU','P  ',
        'CCC','P  ',
        'CCA','P  ',
        'CCG','P  ',
        'CAU','H  ',
        'CAC','H  ',
        'CAA','Q  ',
        'CAG','Q  ',
        'CGU','R  ',
        'CGC','R  ',
        'CGA','R  ',
        'CGG','R  ',
 
        'AUU','I  ',
        'AUC','I  ',
        'AUA','I  ',
        'AUG','M  ',
        'ACU','T  ',
        'ACC','T  ',
        'ACA','T  ',
        'ACG','T  ',
        'AAU','N  ',
        'AAC','N  ',
        'AAA','K  ',
        'AAG','K  ',
        'AGU','S  ',
        'AGC','S  ',
        'AGA','R  ',
        'AGG','R  ',
        
        'GUU','V  ',
        'GUC','V  ',
        'GUA','V  ',
        'GUG','V  ',
        'GCU','A  ',
        'GCC','A  ',
        'GCA','A  ',
        'GCG','A  ',
        'GAU','D  ',
        'GAC','D  ',
        'GAA','E  ',
        'GAG','E  ',
        'GGU','G  ',
        'GGC','G  ',
        'GGA','G  ',
        'GGG','G  ' );
 
print "Enter your file name:\n";
chomp(my $dna = <STDIN>);
open INFILE, "$dna" || die ($!, "Can't open");
my @sequence = <INFILE>;
 
open OUTFILE, ">>proteina7.txt" || die ($!, "Can't open");
 
foreach my $sequence (@sequence){
    
$sequence = uc $sequence;  # pasamos a mayusculas
$sequence =~ s/T/U/g;
 
my $no_of_bases = length $sequence;
 
print OUTFILE ("$sequence\n");
 
for my $desplazamiento (0 .. 2) {
Proteina($desplazamiento);
}
 
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 );
 
        my $amino_acid_sequence .= $AA3{ $codon };
        my $amino_acid_sequence_single .= $AA1{ $codon };
    }
 
    
    print OUTFILE ("$amino_acid_sequence \n");
    print OUTFILE ("$amino_acid_sequence_single \n");
}
 
my $sequence_r = reverse $sequence;
print OUTFILE ("$sequence_r\n\n");
 
for my $desplazamiento_r (0 .. 2) {
Proteina_r($desplazamiento_r);
}
 
sub Proteina_r {
    my $desplazamiento_r = shift;                         # leemos el desplazamiento de marco (0..2)
    my $amino_acid_sequence_r;
    my $amino_acid_sequence_single_r;
 
    for (my $i = $desplazamiento_r; $i < $no_of_bases; $i += 3) {
        
        my $codon_r = substr( $sequence_r, $i, 3 );
 
        my $amino_acid_sequence_r .= $AA3{ $codon_r};
        my $amino_acid_sequence_single_r .= $AA1{ $codon_r };
    }
 
    
    print OUTFILE ("$amino_acid_sequence_r \n");
    print OUTFILE ("$amino_acid_sequence_single_r \n");
}
}
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

por **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

my $secuencia_a_analizar;
Coloreado en 0.001 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

$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

    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

    my $desplazamiento = shift;                         # leemos el desplazamiento de marco (0..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

    my $desplazamiento_r = shift;                         # leemos el desplazamiento de marco (0..2)
    my $sequence_r = shift;                               # secuencia a analizar
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **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

#!/c:/Perl -w
 
my %AA3 = ( 
        'UUU','Phe',
        'UUC','Phe',
        'UUA','Leu',
        'UUG','Leu',
        'UCU','Ser',
        'UCC','Ser',
        'UCA','Ser',
        'UCG','Ser',
        'UAU','Tyr',
        'UAC','Tyr',
        'UAA','***',
        'UAG','***',
        'UGU','Cys',
        'UGC','Cys',
        'UGA','***',
        'UGG','Trp',
        
        'CUU','Leu',
        'CUC','Leu',
        'CUA','Leu',
        'CUG','Leu',
        'CCU','Pro',
        'CCC','Pro',
        'CCA','Pro',
        'CCG','Pro',
        'CAU','His',
        'CAC','His',
        'CAA','Gln',
        'CAG','Gln',
        'CGU','Arg',
        'CGC','Arg',
        'CGA','Arg',
        'CGG','Arg',
 
        'AUU','Ile',
        'AUC','Ile',
        'AUA','Ile',
        'AUG','Met',
        'ACU','Thr',
        'ACC','Thr',
        'ACA','Thr',
        'ACG','Thr',
        'AAU','Asn',
        'AAC','Asn',
        'AAA','Lys',
        'AAG','Lys',
        'AGU','Ser',
        'AGC','Ser',
        'AGA','Arg',
        'AGG','Arg',
        
        'GUU','Val',
        'GUC','Val',
        'GUA','Val',
        'GUG','Val',
        'GCU','Ala',
        'GCC','Ala',
        'GCA','Ala',
        'GCG','Ala',
        'GAU','Asp',
        'GAC','Asp',
        'GAA','Glu',
        'GAG','Glu',
        'GGU','Gly',
        'GGC','Gly',
        'GGA','Gly',
        'GGG','Gly' );
        
my %AA1 = ( 
        'UUU','F  ',
        'UUC','F  ',
        'UUA','L  ',
        'UUG','L  ',
        'UCU','S  ',
        'UCC','S  ',
        'UCA','S  ',
        'UCG','S  ',
        'UAU','Y  ',
        'UAC','Y  ',
        'UAA','*  ',
        'UAG','*  ',
        'UGU','C  ',
        'UGC','C  ',
        'UGA','*  ',
        'UGG','W  ',
        
        'CUU','L  ',
        'CUC','L  ',
        'CUA','L  ',
        'CUG','L  ',
        'CCU','P  ',
        'CCC','P  ',
        'CCA','P  ',
        'CCG','P  ',
        'CAU','H  ',
        'CAC','H  ',
        'CAA','Q  ',
        'CAG','Q  ',
        'CGU','R  ',
        'CGC','R  ',
        'CGA','R  ',
        'CGG','R  ',
 
        'AUU','I  ',
        'AUC','I  ',
        'AUA','I  ',
        'AUG','M  ',
        'ACU','T  ',
        'ACC','T  ',
        'ACA','T  ',
        'ACG','T  ',
        'AAU','N  ',
        'AAC','N  ',
        'AAA','K  ',
        'AAG','K  ',
        'AGU','S  ',
        'AGC','S  ',
        'AGA','R  ',
        'AGG','R  ',
        
        'GUU','V  ',
        'GUC','V  ',
        'GUA','V  ',
        'GUG','V  ',
        'GCU','A  ',
        'GCC','A  ',
        'GCA','A  ',
        'GCG','A  ',
        'GAU','D  ',
        'GAC','D  ',
        'GAA','E  ',
        'GAG','E  ',
        'GGU','G  ',
        'GGC','G  ',
        'GGA','G  ',
        'GGG','G  ' );
 
print "Enter your file name:\n";
chomp($dna = <STDIN>);
open INFILE, "$dna" || die ($!, "Can't open");
@sequence = <INFILE>;
 
open OUTFILE, ">>proteinaC6.txt" || die ($!, "Can't open");
 
foreach $sequence (@sequence){
    
$sequence = uc $sequence;  # produces the upper case string
 
$sequence =~ s/T/U/g;
 
$no_of_bases = length $sequence;
 
print OUTFILE ("$sequence\n");
 
my $p1 = &Proteina_1;
my $p2 = &Proteina_2;
my $p3 = &Proteina_3;
 
 
$sequence_r = reverse $sequence;
print OUTFILE ("$sequence_r\n\n");
 
my $p1_r = &Proteina_1r;
my $p2_r = &Proteina_2r;
my $p3_r = &Proteina_3r;
 
}
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)
        {
        my $codon = substr( $sequence, $i, 3 );
        $amino_acid_sequence_1 .= $AA3{ $codon };
        $amino_acid_sequence_single_1 .=  $AA1{ $codon };
        }
 
print OUTFILE ("$amino_acid_sequence_1\n");
print OUTFILE ("$amino_acid_sequence_single_1\n");
}
 
sub Proteina_2 {
    my $amino_acid_sequence_2;                            # variables locales temporales
    my $amino_acid_sequence_single_2;
for (my $i = 1; $i<$no_of_bases; $i += 3)
        {
        my $codon_2 = substr( $sequence, $i, 3 );
        $amino_acid_sequence_2 .=  $AA3{ $codon_2};
        $amino_acid_sequence_single_2 .=  $AA1{ $codon_2};
        }
 
print OUTFILE (" $amino_acid_sequence_2\n");
print OUTFILE (" $amino_acid_sequence_single_2\n");
}
 
sub Proteina_3 {
    my $amino_acid_sequence_3;                            # variables locales temporales
    my $amino_acid_sequence_single_3;
    
for (my $i = 2 ; $i<$no_of_bases; $i += 3)
        {
        my $codon_3 = substr( $sequence, $i, 3 );
        $amino_acid_sequence_3 .=  $AA3{ $codon_3};
        $amino_acid_sequence_single_3 .=  $AA1{ $codon_3};
        }
 
print OUTFILE ("  $amino_acid_sequence_3\n");
print OUTFILE ("  $amino_acid_sequence_single_3\n\n");
}
sub Proteina_1r {
    my $amino_acid_sequence_1r;                            # variables locales temporales
    my $amino_acid_sequence_single_1r;
   
for (my $i = 0; $i<$no_of_bases; $i += 3)
        {
        my $codon_1r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_1r .=  $AA3{ $codon_1r};
        $amino_acid_sequence_single_1r .=  $AA1{ $codon_1r};
        }
 
print OUTFILE ("$amino_acid_sequence_1r\n");
print OUTFILE ("$amino_acid_sequence_single_1r\n");
}
 
sub Proteina_2r {
    my $amino_acid_sequence_2r;                            # variables locales temporales
    my $amino_acid_sequence_single_2r;
 
for (my $i = 1; $i<$no_of_bases; $i += 3)
        {
        my $codon_2r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_2r .=  $AA3{ $codon_2r};
        $amino_acid_sequence_single_2r .=  $AA1{ $codon_2r};
        }
 
print OUTFILE (" $amino_acid_sequence_2r\n");
print OUTFILE (" $amino_acid_sequence_single_2r\n");
}
 
sub Proteina_3r {
    my $amino_acid_sequence_3r;                            # variables locales temporales
    my $amino_acid_sequence_single_3r;
    
for (my $i = 2 ; $i<$no_of_bases; $i += 3)
        {
        my $codon_3r = substr( $sequence_r, $i, 3 );
        $amino_acid_sequence_3r .=  $AA3{ $codon_3r };
        $amino_acid_sequence_single_3r .=  $AA1{ $codon_3r };
        }
 
print OUTFILE ("  $amino_acid_sequence_3r\n");
print OUTFILE ("  $amino_acid_sequence_single_3r\n\n");
}
Coloreado en 0.006 segundos,  usando GeSHi 1.0.8.4

Un saludo y que mil bendiciones sean contigo y los tuyos

por **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

chomp(my $dna = <STDIN>);
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my @sequence = <INFILE>;
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

foreach my $seq (@sequence){
$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

#!/usr/bin/perl
#
# Conversión de secuencias de ADN a proteínas,
# mostrando los seis marcos de lecturas posibles.
#
# Joaquín Ferrero. 20100818.
#
# Entradas
#       Ninguna. El programa solicita el nombre del fichero con las secuencias
#       genómicas a traducir.
# Salidas
#       Se crea un fichero con el mismo nombre que el fichero indicado, con la
#       extensión añadida '.c6'.
#
 
use common::sense;                      # activamos Perl Moderno
 
### Definición de las proteínas ###############################################
my %aminoácidos1 = (
    UUU => 'F',    CUU => 'L',    AUU => 'I',    GUU => 'V',
    UUC => 'F',    CUC => 'L',    AUC => 'I',    GUC => 'V',
    UUA => 'L',    CUA => 'L',    AUA => 'I',    GUA => 'V',
    UUG => 'L',    CUG => 'L',    AUG => 'M',    GUG => 'V',
    UCU => 'S',    CCU => 'P',    ACU => 'T',    GCU => 'A',
    UCC => 'S',    CCC => 'P',    ACC => 'T',    GCC => 'A',
    UCA => 'S',    CCA => 'P',    ACA => 'T',    GCA => 'A',
    UCG => 'S',    CCG => 'P',    ACG => 'T',    GCG => 'A',
    UAU => 'Y',    CAU => 'H',    AAU => 'N',    GAU => 'D',
    UAC => 'Y',    CAC => 'H',    AAC => 'N',    GAC => 'D',
    UAA => '*',    CAA => 'Q',    AAA => 'K',    GAA => 'E',
    UAG => '*',    CAG => 'Q',    AAG => 'K',    GAG => 'E',
    UGU => 'C',    CGU => 'R',    AGU => 'S',    GGU => 'G',
    UGC => 'C',    CGC => 'R',    AGC => 'S',    GGC => 'G',
    UGA => '*',    CGA => 'R',    AGA => 'R',    GGA => 'G',
    UGG => 'W',    CGG => 'R',    AGG => 'R',    GGG => 'G',
);
 
my %aminoácidos3 = (
    UUU => 'Phe',    CUU => 'Leu',    AUU => 'Ile',    GUU => 'Val',
    UUC => 'Phe',    CUC => 'Leu',    AUC => 'Ile',    GUC => 'Val',
    UUA => 'Leu',    CUA => 'Leu',    AUA => 'Ile',    GUA => 'Val',
    UUG => 'Leu',    CUG => 'Leu',    AUG => 'Met',    GUG => 'Val',
    UCU => 'Ser',    CCU => 'Pro',    ACU => 'Thr',    GCU => 'Ala',
    UCC => 'Ser',    CCC => 'Pro',    ACC => 'Thr',    GCC => 'Ala',
    UCA => 'Ser',    CCA => 'Pro',    ACA => 'Thr',    GCA => 'Ala',
    UCG => 'Ser',    CCG => 'Pro',    ACG => 'Thr',    GCG => 'Ala',
    UAU => 'Tyr',    CAU => 'His',    AAU => 'Asn',    GAU => 'Asp',
    UAC => 'Tyr',    CAC => 'His',    AAC => 'Asn',    GAC => 'Asp',
    UAA => '***',    CAA => 'Gln',    AAA => 'Lys',    GAA => 'Glu',
    UAG => '***',    CAG => 'Gln',    AAG => 'Lys',    GAG => 'Glu',
    UGU => 'Cys',    CGU => 'Arg',    AGU => 'Ser',    GGU => 'Gly',
    UGC => 'Cys',    CGC => 'Arg',    AGC => 'Ser',    GGC => 'Gly',
    UGA => '***',    CGA => 'Arg',    AGA => 'Arg',    GGA => 'Gly',
    UGG => 'Trp',    CGG => 'Arg',    AGG => 'Arg',    GGG => 'Gly',
);
 
 
### Introducción del nombre del fichero a traducir ############################
print 'Entre el nombre del fichero a procesar: ';
my $FICHERO_ADN = <STDIN>;
chomp $FICHERO_ADN;
 
-f $FICHERO_ADN
    or die "ERROR: No puedo acceder al fichero $FICHERO_ADN: $!\n";
 
### Apertura de ficheros ######################################################
open my $ENTRADA, q[<], $FICHERO_ADN
    or die "ERROR: No puedo leer el fichero $FICHERO_ADN: $!\n";
 
open my $SALIDA, q[>], "$FICHERO_ADN.c6"
    or die "ERROR: No puedo escribir el fichero $FICHERO_ADN.c6: $!\n";
 
 
### Lectura y procesado #######################################################
while (my $secuencia = <$ENTRADA>) {
 
    chomp $secuencia;
 
#    $secuencia = uc $secuencia;
 
    $secuencia =~ tr/T/U/;
 
    proteínas($secuencia);
 
    $secuencia = reverse $secuencia;
 
    proteínas($secuencia);
 
    print $SALIDA "\n";
}
 
### Cierre de fichero #########################################################
close $ENTRADA;
close $SALIDA;
 
 
### Fin #######################################################################
say 'Terminado';
 
 
### Subrutinas ################################################################
sub proteínas {
    my $secuencia = shift;
 
    say $SALIDA  $secuencia;
 
    for my $offset ( 0 .. 2 ) {
 
        my $secuencia_aminoácidos;
        my $secuencia_aminoácidos_single;
 
        my $seq = substr $secuencia, $offset;
 
        while ($seq =~ m/(...)/g) {                           # por cada codón
            $secuencia_aminoácidos        .= $aminoácidos3{ $1 };   # lo traducimos
            $secuencia_aminoácidos_single .= $aminoácidos1{ $1 } . '  ';
        }
 
        say $SALIDA  q[ ] x $offset  .  $secuencia_aminoácidos;
        say $SALIDA  q[ ] x $offset  .  $secuencia_aminoácidos_single;
    }
 
    print $SALIDA  "\n";
}
 
__END__
Coloreado en 0.004 segundos,  usando GeSHi 1.0.8.4

Foro - Perl en Español

Problema con subrutinas

Problema con subrutinas

Publicidad

Re: Problema con subrutinas

Re: Problema con subrutinas

Re: Problema con subrutinas

Re: Problema con subrutinas

Re: Problema con subrutinas

¿Quién está conectado?