Reabro el tema:
El problema consiste en conseguir las posibles posiciones a acordes en una guitarra.
Para cada nota musical, se le asigna una cuerda, un espacio y un dedo de la mano izquierda (1..4), de la forma "<string, fret, finger>" respectivamente.
NOTA: Suponiendo que la mano izquierda es la que se mueve por sobre el mástil o el diapasón de la guitarra.
Los espacios se numeran del 1 al 24, partiendo desde la clavija de la guitarra, hasta la caja de ella.
Using perl Syntax Highlighting
my $FA = <<END;
<6,1,1> # Cuerda seis, espacio 1, dedo indice de la mano izquierda
<6,1,2> # Cuerda seis, espacio 1, dedo medio de la mano izquierda
<6,1,3> # Cuerda seis, espacio 1, dedo anular de la mano izquierda
<6,1,4> # Cuerda seis, espacio 1, dedo meñique de la mano izquierda
END
# Para la nota DO, se puede tocar en dos cuerdas, y sonará la misma nota.
my $DO = <<END;
<5,3,1> # Cuerda cinco
<5,3,2>
<5,3,3>
<5,3,4>
<6,8,1> # Cuerda seis
<6,8,2>
<6,8,3>
<6,8,4>
END
# Para la nota MI, se puede tocar en tres cuerdas distintas, y sonará la misma nota
my $MI = <<END;
<4,2,1> # Cuerda cuatro, espacio 2
<4,2,2>
<4,2,3>
<4,2,4>
<5,7,1> # Cuerda cinco, espacio 7
<5,7,2>
<5,7,3>
<5,7,4>
<6,12,1> # Cuerda seis, espacio 12
<6,12,2>
<6,12,3>
<6,12,4>
END
Coloreado en 0.001 segundos, usando
GeSHi 1.0.8.4
Un acorde se compone de 2 o más notas tocadas a la vez. Si las tres notas descritas arriba se tocan a la vez, cada una de estas combinaciones representará una columna, o nodo. Su dominio, será todas las posibles combinaciones para cada nota en cada cuerda. Las restricciones son:
1) Solo una nota por cuerda
2) Dedos con número mayor, tocan solo espacios con un numero mayor.
Ej: a) Si toco la segunda cuerda en el tercer espacio con el dedo índice (<2,3,1>), no puedo tocar con ningún otro dedo espacios superiores.
b) Si toco la segunda cuerda en el tercer espacio con el dedo medio (<2,3,2>), solo podré tocar en algún espacio superior con el dedo índice (<2,3,2> es válido con <3,2,1> por ejemplo)
3) Una máxima distancia entre los dedos.
Ej: Si estoy tocando en el primer espacio <x,1,x>, no puedo tocar a la vez en el doceavo espacio <x,12,x>
Distancias:
1) Entre el índice (1) y el meñique (4) no puedo superar los 4 espacios de distancia.
2) Entre el índice (1) y el anular (3) no puedo superar los 3 espacios
3) Entre el índice (1) y el medio (2) no puedo superar 2 espacios
4) Entre el medio (2) y el meñique (4) no puedo superar 3 espacios
5) Entre el medio (2) y el anular (3) no puedo superar 1 espacio
6) Entre el anular (3) y el meñique (4) no puedo superar 2 espacios
Ej: <4,2,3> y <3,5,4> no cumple la restricción entre anular y meñique (6), porque la resta entre los espacios es 5-2 = 3, y supero los 2 espacios.
4) Sólo el dedo índice, puede hacer una cejilla
Ej: <2,2,1> es válido con <1,2,1>, <3,2,1>, <4,2,1>, <5,2,1>, y <6,2,1>.
<2,2,2> no es valido con <1,2,2>, ya que sólo el índice puede hacer cejilla
Al problema le he ido agregando algunas restricciones, pero las más importantes están descritas arriba
Using perl Syntax Highlighting
# Recibe dos valores, <x,x,x> y <x,x,x>. Si el par cumple con las restricciones, retorna 1, sino, retorna -1
sub isValid{
my($uno,$dos) = @_;
my ($string_1,$fret_1,$finger_1) = getData($uno);#getData, separa <x,x,x> y retorna $string,$fret,$finger, para ser comparados individualmente
my ($string_2,$fret_2,$finger_2) = getData($dos);
if($string_1 == $string_2){# Una nota por cuerda
#print "\nNo cumple una nota por cuerda <$string_1,$fret_1,$finger_1> <$string_2,$fret_2,$finger_2>";
return -1;
}
elsif($finger_1 == 0 or $finger_2 == 0){# Cuerda al aire
return 1;
}
elsif($fret_1 == $fret_2 and $string_1 < $string_2 and $finger_1 < $finger_2){
return -1;
}
elsif($finger_1 == $finger_2 and $fret_1 == $fret_2 and $finger_1 != 1){# Solo el índice hace el barré
return -1;
}
elsif($finger_1 == $finger_2 and $fret_1 == $fret_2 and $finger_1 == 1){# Solo el índice hace el barré o cejilla
return 1;
}
elsif(modulo($string_1-$string_2) == 1 and $fret_1 == $fret_2 and modulo($finger_1-$finger_2) != 1){
return -1;
}
elsif($fret_1 < $fret_2 and $finger_2 <= $finger_1){# Espacios menores, se tocan con dedos menores
return -1;
}
elsif($fret_1 > $fret_2 and $finger_2 >= $finger_1){# Espacios mayores, se tocan con dedos mayores
return -1;
}
elsif($string_1 > $string_2 and $finger_1 > $finger_2 and $fret_1 == $fret_2){# En duda
return -1;
}
elsif(MaxSpanOverFingerPairs($fret_1,$finger_1,$fret_2,$finger_2) == 0){# La distancia máx que es posible con los dedos
return -1;
}
return 1;
}
sub MaxSpanOverFingerPairs{
my($fret_1,$finger_1,$fret_2,$finger_2) = @_;
if($finger_1 == 1){
if($finger_2 == 2){return modulo($fret_2-$fret_1) > 2 ? 0 : 1;}
if($finger_2 == 3){return modulo($fret_2-$fret_1) > 3 ? 0 : 1;}
if($finger_2 == 4){return modulo($fret_2-$fret_1) > 4 ? 0 : 1;}
}
if($finger_1 == 2){
if($finger_2 == 1){return modulo($fret_2-$fret_1) > 2 ? 0 : 1;}
if($finger_2 == 3){return modulo($fret_2-$fret_1) > 1 ? 0 : 1;}
if($finger_2 == 4){return modulo($fret_2-$fret_1) > 3 ? 0 : 1;}
}
if($finger_1 == 3){
if($finger_2 == 1){return modulo($fret_2-$fret_1) > 3 ? 0 : 1;}
if($finger_2 == 2){return modulo($fret_2-$fret_1) > 1 ? 0 : 1;}
if($finger_2 == 4){return modulo($fret_2-$fret_1) > 2 ? 0 : 1;}
}
if($finger_1 == 4){
if($finger_2 == 1){return modulo($fret_2-$fret_1) > 4 ? 0 : 1;}
if($finger_2 == 2){return modulo($fret_2-$fret_1) > 3 ? 0 : 1;}
if($finger_2 == 3){return modulo($fret_2-$fret_1) > 1 ? 0 : 1;}
}
return 1;
}
Coloreado en 0.003 segundos, usando
GeSHi 1.0.8.4
Lo primero que hace mi programa es, comparar todas las notas que están en el acorde (pueden ir de dos a seis) y eliminar de su dominio aquellas que no cumplen con las restricciones. Luego, realiza una búsqueda en profundidad
(Deep Search First) para saber todas las posibles soluciones, con la siguiente función recursiva:
Using perl Syntax Highlighting
sub getSolutions{
my ($ref_array_hashes,$i,$ref_dominio,$ref_recorrido,$ref_solutions) = @_;# Recibe un arreglo, dentro del cual están las notas que se han de comparar. ($[0]= FA, $[1] = DO, $[2] = MI). Pueden ser hasta 6 notas
my @hashes = @{$ref_array_hashes};
if(scalar(@hashes) == 0){
my @array = @{$ref_dominio};
my @solutions;
if (reviseBarre($ref_dominio) == 1){
my $join;
foreach(@{$ref_dominio}){
$_ =~ s/\n//g;
$join .= $_." - ";
}
push(@{$ref_solutions},$join);
}
pop(@array);
return $i-1,\@array,$ref_solutions;
}
my $ref_hash = $hashes[0];# Obtengo el primer layer del arreglo
my %layer = %{$ref_hash};
if($i > 0){
my $dominio = $ref_recorrido;
foreach my $recorrido (@{$layer{$dominio}}){
my $control = 0;
foreach(@{$ref_dominio}){
$control = 1 if (isValid($_,$recorrido) == -1);
}
my $array;
if($control == 0){
push(@{$ref_dominio},$dominio);
$array = shift(@hashes);
if(scalar(@hashes) == 0){push(@{$ref_dominio},$recorrido);}
($i,$ref_dominio,$ref_solutions) = getSolutions(\@hashes,$i+1,$ref_dominio,$recorrido,$ref_solutions);
pop(@{$ref_dominio});
unshift(@hashes,$array);
}
}
return $i-1,$ref_dominio,$ref_solutions;
}
foreach my $dominio (keys %layer){
foreach my $recorrido (@{$layer{$dominio}}){
push(@{$ref_dominio},$dominio);
my $array = shift(@hashes);
($i,$ref_dominio,$ref_solutions) = getSolutions(\@hashes,$i+1,$ref_dominio,$recorrido,$ref_solutions);
pop(@{$ref_dominio});
unshift(@hashes,$array);
}
}
return $ref_solutions;
}
Coloreado en 0.003 segundos, usando
GeSHi 1.0.8.4
Esta función, busca en las diferentes capas (FA,DO,MI) por las soluciones mientras sean arco-consistentes, es decir, que entre ellas satisfagan el conjunto de restricciones.
El uso de Prolog, facilitaría mucho las cosas. La velocidad en el procesamiento creo que aumentaría considerablemente. Podría hacer un mejor manejo de las variables involucradas, etc, etc, etc... Prolog definitivamente es mucho mejor para solucionar un problema como este.
Me interesa mucho este módulo para usar swi-prolog. Este problema está basado en la
tesis de Daniele Radicioni. Él me ha enviado el código de su programa. Aunque no lo he podido ejecutar, sí he visto que está escrito en C++, pero creo que la solución se puede optimizar y hacerla muchísimo más eficiente.
Quizás este no sea un tema para el foro Básico, mis escusas, pero debía reabrir este tema.
Espero haber sido claro en lo expuesto. La explicación del código creo que es un tanto innecesaria, ya que deseo hacerlo en Prolog.
Me despido como siempre, muy agradecido de que exista este foro
¡¡¡Saludos!!!
por panterozo » 2010-07-27 23:30 @021 
