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);