##############################################
## PROGRAMA DE OPTIMIZACIÓN DE ALINEAMIENTO ##
##############################################
use strict;
use Benchmark;
$| = 1; # De este modo no hace todos los prints al final del programa y los va sacando uno a uno
print "1) Introduzca el valor de penalización por GAP: \n";
my $castigoGAP = <STDIN>;
my @secuencias;
my $tiempo_inicial;
my $tiempo_final;
my $tiempo;
my @ss;
my $ss;
my $archivo;
my @filedata;
my $archivo_txt;
my @matriz;
my @ssRev;
my $ssRev;
my $linea;
########################################################################################################
##########################################################
## SUBRUTINAS UTILIZADAS EN EL PROGRAMA DE ALINEAMIENTO ##
##########################################################
sub get_file_data {
my ($filename) = @_;
unless ( open( GET_FILE_DATA, $filename ) ) {
print STDERR "No se puede abrir el fichero \"$filename\"\n\n";
exit;
}
@filedata = <GET_FILE_DATA>;
return @filedata;
}
sub extract_seq {
my @archivo = @_;
foreach my $line (@archivo) {
if ( $line =~ /^\s*$/ ) {
next;
}
elsif ( $line =~ /^\s*[0-9]/ ) {
next;
}
else {
$line =~ s/\n//g; #Elimina el salto de linea
push( @ss, $line );
}
}
}
sub Alineamiento_Fusion {
#####################################################################
## Subrutina que rellena 2 tablas con programación dinámica @M ##
## y @como, las cuales nos devuelven el mejor resultado posible ##
## para la fusión de alineamientos de $S y $T, y como añadir a ##
## estas dos $ los GAPs de la manera más cercana al óptimo. ##
## Devuelve el mejor marcador, haciendo referencia a @como. ##
#####################################################################
my ( $S, $T ) = @_; # Alineamiento que hace referencia a una lista de secuencias
# con los GAPs
my ( $sLong, $tLong ) = ( length( $$S[0] ), length( $$T[0] ) );
my @Sgaps = ( ("-") x @$S );
my @Tgaps = ( ("-") x @$T );
my @M;
my @como;
$M[0][0] = 0;
foreach my $i ( 1 .. $sLong ) {
$como[$i][0] = "|";
my @Scol = map { substr( $_, $i - 1, 1 ) } @$S;
$M[$i][0] = $M[ $i - 1 ][0] + marcadorCol( @Scol, @Tgaps );
}
foreach my $j ( 1 .. $tLong ) {
$como[0][$j] = "-";
my @Tcol = map { substr( $_, $j - 1, 1 ) } @$T;
$M[0][$j] = $M[0][ $j - 1 ] + marcadorCol( @Sgaps, @Tcol );
}
foreach my $i ( 1 .. $sLong ) {
foreach my $j ( 1 .. $tLong ) {
my @Scol = map { substr( $_, $i - 1, 1 ) } @$S;
my @Tcol = map { substr( $_, $j - 1, 1 ) } @$T;
$M[$i][$j] = $M[ $i - 1 ][ $j - 1 ] + marcadorCol( @Scol, @Tcol );
$como[$i][$j] = "\\";
my $left = $M[$i][ $j - 1 ] + marcadorCol( @Sgaps, @Tcol );
if ( $left > $M[$i][$j] ) {
$M[$i][$j] = $left;
$como[$i][$j] = "-";
}
my $up = $M[ $i - 1 ][$j] + marcadorCol( @Scol, @Tgaps );
if ( $up > $M[$i][$j] ) {
$M[$i][$j] = $up;
$como[$i][$j] = "|";
}
}
}
return ( $M[$sLong][$tLong], \@como );
}
########################################################################################################
sub AñadeColumPrevia {
###################################################################################
## Añade una nueva columna en el extremo izquierdo de un alineamiento existente ##
###################################################################################
my ($A, @col)= @_; ## Este alineamiento hace referencia a una lista de cadenas
## Lista de bases a añadir a cada cadena de alineamiento
foreach (@$A) {$_ = (shift @col).$_};
}
########################################################################################################
sub ComparaCadenas {
################################################################################
## Dada una serie de cadenas, las ordena en función de su longitud y compara ##
## las bases T, C, G y A de cada una de las cadenas devolviendo el número ##
## de bases que coinciden en todas las cadenas introducidas. ##
################################################################################
my @matriz = @_;
my $longitud = length( $matriz[1] );
my @bases = ( 'T', 'C', 'G', 'A' );
my $coincid = 0;
my @similitud;
for ( my $i = 0; $i < $longitud; $i++ ) {
for ( my $z = 0; $z < int(@matriz); $z++ ) {
$similitud[$z] = substr( $matriz[$z], $i, 1 );
}
for ( my $j = 0; $j < 4; $j++ ) {
my $c = $bases[$j];
my $contar = 0;
foreach (@similitud) {
if (/$c/) {
++$contar;
}
}
if ( $contar == int(@similitud) ) {
$coincid++;
}
}
}
return $coincid;
}
#######################################################################################################
sub EstrategiaOptima {
#################################################################################
## Dada una lista de secuencias, aplica una estrategia de fusión que busca ##
## maximizar el alineamiento, pese a no tener por que ser el óptimo. ##
## Dicha estrategia consiste en la maximización de manera repetitiva de la ##
## ganancia inmediata por la fusión de cualquier secuencia individual con ##
## las alineaciones existentes. ##
## Devuelve el resultado final del alineamiento múltiple. ##
#################################################################################
my @ss = @_; ## Argument list is a list of sequences.
my ( $bestI, $bestJ, $bestScore ) = ( -1, -1, -999999999 ); ## Busca el mejor molde para la fusión.
foreach my $i ( 0 .. $#ss ) {
foreach my $j ( $i + 1 .. $#ss ) {
my ( $score, $como ) = Alineamiento_Fusion( [ $ss[$i] ], [ $ss[$j] ] );
( $bestI, $bestJ, $bestScore ) = ( $i, $j, $score )
if $score > $bestScore;
}
}
my $alineamiento = FusionAlineamiento( [ $ss[$bestI] ], [ $ss[$bestJ] ] ); ## Fusión.
splice( @ss, $bestJ, 1 );
splice( @ss, $bestI, 1 );
while (@ss) {
my ( $bestI, $bestScore ) = ( -1, -999999999 ); ## Busca la mejor secuencia para
foreach my $i ( 0 .. $#ss ) { ## añadirla al alineamiento.
my ( $score, $como ) = Alineamiento_Fusion( [ $ss[$i] ], $alineamiento );
( $bestI, $bestScore ) = ( $i, $score ) if $score > $bestScore;
}
$alineamiento = FusionAlineamiento( [ $ss[$bestI] ], $alineamiento ); ## Añade la mejor secuencia al
splice( @ss, $bestI, 1 ); ## alinemiento, la elimina de @ss
}
return $alineamiento;
}
########################################################################################################
sub FusionAlineamiento {
########################################################################################
## Fusiona dos alineamientos para hallar el máximo resultado de fusión posible ##
## Devuelve el resultado del alineaminto, hace referencia a una lista de cadenas. ##
########################################################################################
my ( $S, $T ) = @_;
my ( $score, $como ) = Alineamiento_Fusion( $S, $T );
my @result = ( ("") x ( @$S + @$T ) );
my ( $i, $j ) = ( length( $$S[0] ), length( $$T[0] ) );
my @Sgaps = ( ("-") x @$S );
my @Tgaps = ( ("-") x @$T );
while ( $i > 0 || $j > 0 ) {
if ( $$como[$i][$j] eq "\\" ) {
my @Scol = map { substr( $_, $i - 1, 1 ) } @$S;
my @Tcol = map { substr( $_, $j - 1, 1 ) } @$T;
AñadeColumPrevia(\@result, @Scol, @Tcol);
$i--; $j--;
} elsif ($$como[$i][$j] eq "|") {
my @Scol = map { substr($_,$i-1,1) } @$S;
AñadeColumPrevia(\@result, @Scol, @Tgaps);
$i--;
} elsif ($$como[$i][$j] eq "-") {
my @Tcol = map { substr($_,$j-1,1) } @$T;
AñadeColumPrevia(\@result, @Sgaps, @Tcol);
$j--;
}
}
return \@result;
}
########################################################################################################
sub MarcadorAlinMulti {
#####################################################################
## Resume los resultados de la suma de pares de todas las columnas ##
## de un alineamiento, devolviendo el marcador de la suma de los ##
## pares del alineamiento completo. ##
#####################################################################
my ($alineamiento) = @_;
my $score;
foreach my $i ( 0 .. length( $$alineamiento[0] ) - 1 ) {
$score += marcadorCol( map { substr( $_, $i, 1 ) } @$alineamiento );
}
return $score;
}
#######################################################################################################
sub marcadorCol {
############################################################
## Dada una lista de bases en una columna, devuelve ##
## el marcador de la suma de los pares para una columna ##
############################################################
my @col = @_; # Las bases de la columna
my ( $gaps, $aas, $score ) = ( 0, 0, 0 );
while (@col) {
my $aa = shift @col;
( $gaps++, next ) if $aa eq "-";
$aas++;
foreach my $aa1 (@col) {
next if $aa1 eq "-";
$score += ( $aa eq $aa1 ) ? +1 : -1;
}
}
return $score + ( $castigoGAP * $gaps * $aas );
}
#######################################################################################################
sub ImprimeAlin {
########################################
## Imprime el alineamiento múltiple ##
########################################
my ($alineamiento) ## Hace referencia a una lista de cadenas
= @_;
foreach (@$alineamiento) { push( @secuencias, $_ ); }
return @secuencias;
}
########################################################################################################
sub Exportar_archivo {
my ( $archivo_txt, @exportar ) = @_;
open( Archivo, ">" . $archivo_txt . '.txt' );
my $N = int(@exportar);
for ( my $i = 0; $i < $N; $i++ ) {
print Archivo $exportar[$i] . "\n";
}
close Archivo;
}
###################################################################################################
sub Reverse_ss {
@ssRev = reverse @ss;
foreach $linea (@ss) {
push( @ssRev, reverse $linea );
}
return "@ssRev";
}
#######################################################################################################
#######################################################################################################
###########################
## PROGRAMA: EJECUCIÓN ##
###########################
#######################################################################################################
#######################################################################################################
print "2) Introduzca el nombre del archivo a analizar\n";
$archivo = <STDIN>;
print("\n");
get_file_data($archivo);
extract_seq(@filedata);
{
print "El resultado de comparar las secuencias previo al alineamiento devuelve:\n\n";
print join( "\n", @ss ), "\n\n Cuyo valor de coincidencia en todas las cadenas es: ", ComparaCadenas(@ss),
"\n\n\n";
}
$tiempo_inicial = new Benchmark;
my $count = 0;
@matriz = ();
print "4.1) Introduzca el tamaño de las particiones a realizar previas al alineamiento; \n";
my $val = <STDIN>;
chomp($val);
for ( my $i = 0; $i < length( $ss[1] ); $i += $val ) { ### Si quieres cambios modifica el valor
my @secu;
for ( my $j = 0; $j < int(@ss); $j++ ) {
$secu[$j] = substr( $ss[$j], $i, $val ); ### Si quieres cambios modifica el valor
}
ImprimeAlin( EstrategiaOptima(@secu) );
$count += ComparaCadenas(@secuencias);
for ( my $jj = 0; $jj < int(@secuencias); $jj++ ) {
$matriz[$jj] = $matriz[$jj] . $secuencias[$jj];
}
@secuencias = (); #Borra todo el array.
}
print "\n5.1) El resultado de alinear las secuencias de $val en $val y juntarlas posteriormente es:\n\n";
print join( "\n", @matriz ), "\n\n El valor máximo de alineamiento es: ", $count, "\n\n";
$tiempo_final = new Benchmark;
$tiempo = timediff( $tiempo_final, $tiempo_inicial );
print "El tiempo invertido es:", timestr($tiempo), "\n \n \n";
print "6.1) Introduzca el nombre del archivo de salida, por defecto se le añadirá la extensión .txt \n";
$archivo_txt = <STDIN>;
chomp($archivo_txt);
Exportar_archivo( $archivo_txt, @matriz );
##############################################################################################################
##############################################################################################################
# A partir de aquí me lío y no consigo que funcione
Reverse_ss(@ss);
{
print "El resultado de comparar las secuencias previo al alineamiento devuelve:\n\n";
print join( "\n", @ssRev ), "\n\n Cuyo valor de coincidencia en todas las cadenas es: ",
ComparaCadenas(@ssRev), "\n\n\n";
}
my $tiempo_inicial2 = new Benchmark;
my $count2 = 0;
my @matriz2 = ();
print "4.2) Introduzca el tamaño de las particiones a realizar previas al alineamiento; \n";
$val = <STDIN>;
chomp($val);
for ( my $i = 0; $i < length( $ssRev[1] ); $i += $val ) { ### Si quieres cambios modifica el valor
my @secu;
for ( my $j = 0; $j < int($ssRev); $j++ ) {
$secu[$j] = substr( $ssRev[$j], $i, $val ); ### Si quieres cambios modifica el valor
}
ImprimeAlin( EstrategiaOptima(@secu) );
$count += ComparaCadenas(@secuencias);
for ( my $jj = 0; $jj < int(@secuencias); $jj++ ) {
$matriz2[$jj] = $matriz[$jj] . $secuencias[$jj];
}
@secuencias = (); #Borra todo el array.
}
print "\n5.2) El resultado de alinear las secuencias de $val en $val y juntarlas posteriormente es:\n\n";
print join( "\n", @matriz ), "\n\n El valor máximo de alineamiento es: ", $count2, "\n\n";
$tiempo_final = new Benchmark;
$tiempo = timediff( $tiempo_final, $tiempo_inicial );
print "El tiempo invertido es:", timestr($tiempo), "\n \n \n";
print "6.2) Introduzca el nombre del archivo de salida, por defecto se le añadirá la extensión .txt \n";
$archivo_txt = <STDIN>;
chomp($archivo_txt);
Exportar_archivo( $archivo_txt, @matriz );
