Foro - Perl en Español

por **perl junior** » 2017-01-26 05:00 @250

Buenas, he hecho un programa para calcular la puntuación en un alineamiento, y no entiendo por qué me devuelve el valor 6 y no 4 como debería ser.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use List::Util qw[min max];
sub programacion_dinamica{
        my($secuencia1,$secuencia2) =@_;
        
        my $len1 =length ($secuencia1);
        my $len2 =length($secuencia2);
        my @secuencia1 = split("",$secuencia1);
        my @secuencia2= split("",$secuencia2);
        
        
        #Construimos la tabla s y la inicializamos a 0
        my @s=();
        my @decisiones=();
        for (my $i =0; $i <=$len1 ;$i++){
        
                my @ fila_s=();
                my @fila_decision=();
                for (my $j=0;$j <=$len2;$j++){
                        push @fila_s,0;
                        push@fila_decision,'';
                        print @fila_decision;
                }
                push @s,\@fila_s; #por referencia
                push @decisiones,\@fila_decision;
                
        }
 
        
        
        for (my $i =0;$i<$len1;$i++){
                $s[0][0]= 0;
                $s[$i][0] =$s[$i][0];
                
                $decisiones[$i][0]="abajo";
        }
 
        for (my $j=0;$j<=$len2;$j++){
                
                $s[0][$j] =$s[0][$j];
                
                $decisiones[0][$j]="derecha";
        }
 
        
        for (my $j=1;$j<$len2;$j++){
                for (my $i=1;$i<$len1;$i++){
                        
                        
                        
                        if ($secuencia1[$i-1]== $secuencia2[$j-1]){
                        
                                $suma=1;
                        }
                        else{
                                $suma=0;}
                                
                        $s[$i][$j]=max(
                                $s[$i-1][$j]+0,
                                $s[$i][$j-1]+0,
                                $s[$i-1][$j-1]+$suma);
                        
                        
                    if($s[$i][$j]== $s[$i][$j-1]+0){
                                $decisiones[$i][$j] ="abajo";
                        }
                        
                        elsif ($s[$i][$j]==$s[$i-1][$j-1]+$suma){
                                $decisiones[$i][$j] ="diagonal";
                        }
                        else{
                                $decisiones[$i][$j]="derecha";
                    }
                
                }
        }
        
        
        return$s[$len1-1][$len2-1];
        
}
 
 
#Construimos las tablas y decisiones
 
 
 
$secuencia1="ATGTTATA";
$secuencia2="ATCGTCC";
 
 
my $resultado=programacion_dinamica($secuencia1,$secuencia2);
print $resultado;
 
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Muchas gracias a cualquier pista que me ayude a ver el fallo.

#!/usr/bin/env perl
use v5.14;
 
use List::Util qw[max];
 
sub programacion_dinamica {
    my($secuencia1, $secuencia2) = @_;
 
    my @secuencia1 = split //, $secuencia1;
    my @secuencia2 = split //, $secuencia2;
 
    my @s;
    my @decisiones;
 
    print "  ", join("  " => @secuencia1), "\n";
 
    for (my $j = 0; $j < @secuencia2; $j++) {
        print "$secuencia2[$j] ";
 
        for (my $i = 0; $i < @secuencia1; $i++) {
 
            my $iguales = $secuencia1[$i] eq $secuencia2[$j];               # 1 si hay coincidencia
 
            $s[$i+1][$j+1] = max(
                0        + $s[$i]  [$j+1],
                0        + $s[$i+1][$j],
                $iguales + $s[$i]  [$j]
            );
 
            if ($s[$i+1][$j+1] == $s[$i+1][$j]) {
                $decisiones[$i+1][$j+1] = "v";
            }
 
            elsif ($s[$i+1][$j+1] == $s[$i][$j]+$iguales) {
                $decisiones[$i+1][$j+1] = "\\";
            }
            else {
                $decisiones[$i+1][$j+1] = ">";
            }
 
            print "$s[$i+1][$j+1]$decisiones[$i+1][$j+1] ";
        }
        print "\n";
    }
 
    return $s[@secuencia1][@secuencia2];
}
 
 
#my $secuencia1 = "ATGTTATA";
#my $secuencia2 = "ATCGTCC";
my $secuencia1 = "ATGCTTA";
my $secuencia2 = "TGCATTAA";
 
say programacion_dinamica($secuencia1, $secuencia2);
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

  A  T  G  T  T  A  T  A

A 1\ 1> 1> 1> 1> 1\ 1> 1\ 

T 1v 2\ 2> 2\ 2\ 2> 2\ 2> 

C 1v 2v 2v 2v 2v 2v 2v 2v 

G 1v 2v 3\ 3> 3> 3> 3> 3> 

T 1v 2v 3v 4\ 4\ 4> 4\ 4> 

C 1v 2v 3v 4v 4v 4v 4v 4v 

C 1v 2v 3v 4v 4v 4v 4v 4v 

4Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

por **perl junior** » 2017-01-26 09:09 @423

Muchas gracias, no había caído. Efectivamente, si lo pruebo da el resultado deseado.

Sin embargo si pongo estas 2 secuencias:

secuencia1: ATGCTTA
secuencia2: TGCATTAA

¿El resultado que debe salir no es 6? ¿Por qué devuelve 5?

por **explorer** » 2017-01-26 09:38 @443

Es que me parece que no haces todas las comparaciones de todas las bases. Es decir, los bucles for() van de 1 a longitud(secuencia)-1. La comparación se hace con ($i-1, $j-1), por lo que entonces estamos comparando las bases que van de 0 a longitud(secuencia)-2, lo cual nos deja fuera la última base de cada secuencia.

Entonces... en los bucles for, en lugar de poner '<', pondría '<=', para que hagan una vuelta más.

Y en el return,

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

        return$s[$len1-1][$len2-1];
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

cambiarlo para que sea

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

        return$s[$len1][$len2];
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Mi código también fallaba en el return, así que lo he cambiado y ya sale bien.

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

  A  T  G  C  T  T  A

T 0v 1\ 1> 1> 1\ 1\ 1> 

G 0v 1v 2\ 2> 2> 2> 2> 

C 0v 1v 2v 3\ 3> 3> 3> 

A 1\ 1v 2v 3v 3v 3v 4\ 

T 1v 2\ 2v 3v 4\ 4\ 4v 

T 1v 2v 2v 3v 4v 5\ 5> 

A 1v 2v 2v 3v 4v 5v 6\ 

A 1v 2v 2v 3v 4v 5v 6v 

6Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

por **perl junior** » 2017-01-26 10:12 @466

Siento ser pesado e insistente. Lo de la puntuación lo tengo arreglado, pero no cuando quiero obtener el camino y que me devuelva las bases en las que coinciden.

Si pongo estas secuencias, me lo da perfectamente:
S1= ATGTTATA
S2= ATCGTCC

Pero si pongo estas
S1= ATGCTTA
S2= ATCGTCC

me devuelve este error: Modification of non-creatable array value attempted, subscript -9 at puntuacion.pl line 96.

Y no lo entiendo por qué. Siento las molestias y muchísimas gracias por la ayuda.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

use List::Util qw[min max];
sub programacion_dinamica{
        my($secuencia1,$secuencia2) =@_;
        
        my $len1 =length ($secuencia1);
        my $len2 =length($secuencia2);
        my @secuencia1 = split("",$secuencia1);
        my @secuencia2= split("",$secuencia2);
        
        
        #Construimos la tabla s y la inicializamos a 0
        my @s=();
        my @decisiones=();
        for (my $i =0; $i <=$len1 ;$i++){
        
                my @ fila_s=();
                my @fila_decision=();
                for (my $j=0;$j <=$len2;$j++){
                        push @fila_s,0;
                        push@fila_decision,'';
                        print @fila_decision;
                }
                push @s,\@fila_s; #por referencia
                push @decisiones,\@fila_decision;
                
        }
 
        
        
        for (my $i =0;$i<$len1;$i++){
                $s[0][0]= 0;
                $s[$i][0] =$s[$i][0];
                
                $decisiones[$i][0]="abajo";
        }
 
        for (my $j=0;$j<=$len2;$j++){
                
                $s[0][$j] =$s[0][$j];
                
                $decisiones[0][$j]="derecha";
        }
 
        
        for (my $j=1;$j<= $len2;$j++){
                for (my $i=1;$i<= $len1;$i++){
                        
                        
                        
                        if ($secuencia1[$i-1]eq $secuencia2[$j-1]){
                        
                                $suma=1;
                        }
                        else{
                                $suma=0;}
                                
                        $s[$i][$j]=max(
                                $s[$i-1][$j]+0,
                                $s[$i][$j-1]+0,
                                $s[$i-1][$j-1]+$suma);
                        
                        
                    if($s[$i][$j]== $s[$i][$j-1]+0){
                                $decisiones[$i][$j] ="abajo";
                        }
                        
                        elsif ($s[$i][$j]==$s[$i-1][$j-1]+$suma){
                                $decisiones[$i][$j] ="diagonal";
                        }
                        else{
                                $decisiones[$i][$j]="derecha";
                    }
                
                }
        }
        
        
        
        @camino=();
        @secuencia=();
        @camino =construir_camino($len1-1,$len2-1,\@decisiones,\@secuencia1,@camino,@secuencia);
        
        return $s[$len1][$len2],@camino;
        
}
 
 
 
 
sub construir_camino{
        my ($i,$j,$decisiones_ref,$secuencia1_ref,@camino,@secuencia)=@_;
        if($i ==0 and $j ==0){
                return (@camino);
                
        }
        elsif (${$decisiones_ref}[$i][$j] eq "derecha"){
                
                unshift @camino,"derecha";
                return construir_camino($i-1,$j,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
        }
        elsif (${$decisiones_ref}[$i][$j] eq "abajo"){
                
                unshift @camino,"abajo";
                return construir_camino($i,$j-1,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
        }
        else{
                unshift @camino,"diagonal";
                unshift @secuencia,${$secuencia1_ref}[$i];
                return construir_camino($i-1,$j-1,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
        }
}
 
 
 
 
 
 
 
 
$secuencia1="ATGCTTA";
$secuencia2="TGCATTAA";
 
 
 
my ($resultado,@secuencia)=programacion_dinamica($secuencia1,$secuencia2);
print $resultado,"\n";
print join(" ",@secuencia);
 
 
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

por **explorer** » 2017-01-26 11:45 @531

El problema está en la condición de parada de la creación del camino.

En la línea 92 compruebas si AMBOS índices, el $i y el $j son IGUALES a 0, y en ese caso, regresar con la solución.

Pero... hay situaciones en las cuales los valores se vuelven negativos (aún no sé por qué), por lo que es complicado que se dé la condición de igualdad a 0 en los dos índices a la vez. Cuando se produce el error que muestras, $i vale -9, y $j vale -12. En Perl, los valores negativos se refieren a los índices del array empezando por el final (-1 se refiere al índice del último elemento del array, el -2, el penúltimo, etc.), así que cuando ponemos un valor muy negativo, Perl no puede ir "más allá" del principio del array, por lo que salta el error.

Cambiando la expresión por

if($i <= 0 and $j <= 0) {

Con ese cambio, ya sale bien (aunque con la secuencia de las bases al revés. Para darle la vuelta, usa el comando reverse).

por **perl junior** » 2017-01-26 12:05 @545

Pero la función reverse solo me valdría para ese caso, si se diera el de las anteriores secuencias no valdría ¿no?

por **explorer** » 2017-01-26 12:08 @547

P.D. Estoy casi seguro que es un problema de índices. Quiero decir que hay que tener claro siempre a qué corresponde la primera magnitud (las filas), y la segunda magnitud (las columnas) y que sus respectivas variables de índice no cambian ($i, $j). Y conforme a eso, asignar lo de 'derecha', 'abajo'...

Cuando llegue a casa lo miro con más calma, pero es justo eso: no está garantizado que el algoritmo comienza justo en la esquina inferior derecha, y por eso nunca llega a parar en el (0,0), que sería lo lógico.

por **explorer** » 2017-01-26 12:12 @550

Si antes lo digo...

Con "arreglar" lo de 'abajo' y 'derecha', ya funciona todo.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
#
use List::Util qw[min max];
 
sub programacion_dinamica{
        my($secuencia1,$secuencia2) =@_;
 
        my $len1 =length ($secuencia1);
        my $len2 =length($secuencia2);
        my @secuencia1 = split("",$secuencia1);
        my @secuencia2= split("",$secuencia2);
 
        #Construimos la tabla s y la inicializamos a 0
        my @s=();
        my @decisiones=();
        for (my $i =0; $i <=$len1 ;$i++){
 
                my @ fila_s=();
                my @fila_decision=();
                for (my $j=0;$j <=$len2;$j++){
                        push @fila_s,0;
                        push@fila_decision,'';
                        print @fila_decision;
                }
                push @s,\@fila_s; #por referencia
                push @decisiones,\@fila_decision;
        }
 
 
        for (my $i =0;$i<$len1;$i++){
                $s[0][0]= 0;
                $s[$i][0] =$s[$i][0];
 
                $decisiones[$i][0]="abajo";
        }
 
        for (my $j=0;$j<=$len2;$j++){
 
                $s[0][$j] =$s[0][$j];
 
                $decisiones[0][$j]="derecha";
        }
 
        for (my $j=1;$j<= $len2;$j++){
                for (my $i=1;$i<= $len1;$i++){
 
                        if ($secuencia1[$i-1] eq $secuencia2[$j-1]){
                                $suma=1;
                        }
                        else{
                                $suma=0;
                        }
 
                        $s[$i][$j]=max(
                                $s[$i-1][$j]+0,
                                $s[$i][$j-1]+0,
                                $s[$i-1][$j-1]+$suma);
 
                        if($s[$i][$j]== $s[$i][$j-1]+0){
                                $decisiones[$i][$j] ="derecha";
                        }
                        elsif ($s[$i][$j]==$s[$i-1][$j-1]+$suma){
                                $decisiones[$i][$j] ="diagonal";
                        }
                        else{
                                $decisiones[$i][$j]="abajo";
                    }
                }
        }
 
        @camino=();
        @secuencia=();
 
        use Data::Dump;
        dd @s;
        #exit;
 
 
        @camino =construir_camino($len1,$len2,\@decisiones,\@secuencia1,@camino,@secuencia);
 
        return $s[$len1][$len2],@camino;
}
 
 
 
 
sub construir_camino{
    my ($i,$j,$decisiones_ref,$secuencia1_ref,@camino,@secuencia)=@_;
 
    use Data::Dumper;
    print "$i:$j: \n";# , Dumper $decisiones_ref;
 
    if($i <=0 and $j <=0){
        return (@camino);
 
    }
    elsif ($decisiones_ref->[$i][$j] eq "abajo"){
 
        unshift @camino,"derecha";
        return construir_camino($i-1,$j,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
    }
    elsif ($decisiones_ref->[$i][$j] eq "derecha"){
 
        unshift @camino,"abajo";
        return construir_camino($i,$j-1,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
    }
    else{
        unshift @camino,"diagonal";
        unshift @secuencia,${$secuencia1_ref}[$i];
        return construir_camino($i-1,$j-1,$decisiones_ref,$secuencia1_ref,@camino,@secuencia);
    }
}
 
 
$secuencia1="ATGCTTA";
$secuencia2="TGCATTAA";
 
 
 
my ($resultado,@secuencia)=programacion_dinamica($secuencia1,$secuencia2);
print $resultado,"\n";
print join(" ",@secuencia);
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

(

  [0, 0, 0, 0, 0, 0, 0, 0, 0],

  [0, 0, 0, 0, 1, 1, 1, 1, 1],

  [0, 1, 1, 1, 1, 2, 2, 2, 2],

  [0, 1, 2, 2, 2, 2, 2, 2, 2],

  [0 .. 3, 3, 3, 3, 3, 3],

  [0 .. 3, 3, 4, 4, 4, 4],

  [0 .. 3, 3, 4, 5, 5, 5],

  [0 .. 4, 4, 5, 6, 6],

)

7:8: 

7:7: 

6:6: 

5:5: 

4:4: 

4:3: 

3:2: 

2:1: 

1:0: 

0:0: 

6

derecha diagonal diagonal diagonal abajo diagonal diagonal diagonal abajo  A T T C GColoreado en 0.000 segundos,  usando GeSHi 1.0.8.4

por **perl junior** » 2017-01-26 12:49 @576

De acuerdo, tengo un par de preguntas.

¿Por qué si viene de la derecha añades a @camino abajo?

Además, si vemos el resultado, estaría mal, ¿no debería salir "TGCTTA"?

Y por otra parte, viendo ahora el código tanto en la línea 30 como en la 37 creo que lo tengo mal y que los índices empiecen por 1.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

        for (my $i =1;$i<$len1;$i++){
                
                $s[$i][0] =$s[$i-1][0];
                
                $decisiones[$i][0]="abajo";
        }
 
        for (my $j=1;$j<$len2;$j++){
                
                $s[0][$j] =$s[0][$j-1];
                
                $decisiones[0][$j]="derecha";
        }
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Gracias de nuevamente, estaré atento.

Foro - Perl en Español

Puntuación errónea en alineamiento

Puntuación errónea en alineamiento

Publicidad

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

Re: Puntuación errónea en alineamiento

¿Quién está conectado?