#Enumeración de motivos
sub motifs {
my $t =$_[0];
my $k = $_[1];
my @s =@{$_[2]};#LIsta pasada por referencia
my @secuencias = @{$_[3]};
my @motifs=(); # lista vacía donde iré metiendo las motivos de tamaño k que extraiga de cada secuencia
for (my $i=0; $i< scalar @s; $i++) {
my $indice =$s[$i];
my $secuencia =$secuencias[$i];
my $k_mero = substr ($secuencia,$indice,$k);
push @motifs,$k_mero;
}
return @motifs;
}
my $t1 = 5;
my $k1 = 8;
my @s1 =(6,20,23,10,11);
my @secuencias1 = (
"CGCCCCTCTCGGGGGTGTTCAGTAAACGGCCA",
"GGGCGAGGTATGTGTAAGTGCCAAGGTGCCAG",
"TAGTACCGAGACCGAAAGAAGTATACAGGCGT",
"TAGATCAAGTTTCAGGTGCACGTCGGTGAACC",
"AATCCACCAGCTCCACGTGCAATGTTGGCCTA",
);
sub profile{
my ($t,$k,@motifs) =@_;
my %tabla_profile =();
my @bases = ("A","C","G","T");
foreach my $base (@bases){
my @lista_ceros =();
for (my $i =0; $i<$k;$i++){
push @lista_ceros,0;
}
$tabla_profile{$base} = \@lista_ceros;
#print @{$tabla_profile{"A"}};
}
foreach my $motif(@motifs){ #Queremos acceder a los motivos,vamos a recorrerlos/Al ser irrevelante el índice de la secuencia usar foreach
for (my $i=0;$i<$k;$i++){
my $base = substr($motif,$i,1);#Vamos a extraer cada base de la secuencia, en este caso la posicion es relevante
#$base, es la clave de acceso a la tabla/ $tabla_profile{$base}= referencia a la lista
#@{$tabla{$base}}, hago una copia
#${$tabla{$base}}, acceso al valor de esa lista
my $ref_lista = $tabla_profile{$base}; #COn esto tengo el identificador de la lista
${$ref_lista}[$i] = ${$ref_lista}[$i]+1;
}
}
return %tabla_profile;
#LO primero que tengo que hacer es inicializar la tabla, un buen punto de partida es poner ocho ceros
#declarar una tabla con ocho ceros
}
my @resultado1 = motifs($t1,$k1,\@s1,\@secuencias1);
print join (" ", @resultado1, "\n");
my %tabla= profile($t1,$k1, @resultado1);
foreach my $base (keys%tabla){
my @lista = @{$tabla{$base}};#Me quedo con una copia de la lista a la que referencia
print "Base" ,$base," ",join(" ",@lista), "\n";
}
#if($contador < $num_max_apariciones){$num_max_apariciones =$contador;}
#$num_min_apariciones=$num_max_apariciones
sub puntuacion {
my($k,%profile)=@_;
my @maximos_columnas= ();
my $consenso="";
for( my $i=0;$i<$k;$i++){ # para todas las columnas (en este caso si que interesa la posicion)
my $maximo= 0 ; #vamos a encontrar un máximo de esas columnas
foreach my $base (keys%tabla){ # para todas las filas
@lista = @{$profile{$base}};
my $veces= $lista[$i];
#si el número es mayor que el máximo
if ($maximo < $veces){
$maximo=$veces;
}
}
push @maximos_columnas,$maximo; #guardamos el máximo encontrado en una lista
foreach my $base (keys%tabla){ # para todas las filas
@lista = @{$profile{$base}};
my$repeticiones= $lista[$i];
if ($repeticiones eq $maximo){$consenso=$consenso.$base;}
}
}
$puntuacion_total=0;
foreach $puntuacion (@maximos_columnas){
$puntuacion_total =$puntuacion+$puntuacion_total;
}
return $consenso,$puntuacion_total
}
@resultado=puntuacion($k1,%tabla);
print "La mejor puntuación obtenida es: ",$resultado[1],"\n";
print "La secuencia consenso es: ",$resultado[0];