Problema del salto del caballo:
Resolver el siguiente problema utilizando un algoritmo con vuelta atrás: En un tablero de ajedrez (de tamaño n x n) partimos de una casilla inicial (x,y). Tenemos una ficha de un caballo, que puede realizar los mismos movimientos que en el ajedrez. El objetivo es, partiendo de la posición inicial, visitar todas las casillas del tablero, sin repetir ninguna.


El algoritmo devuelve sólo la primera solución que encuentra.
program caballo;
uses crt;
const n=8;
var dx,dy: array[1..8] of integer;
tab: array[1..n,1..n] of integer;
i,j, aux: integer;
exito:boolean;
Procedure mostrarTablero();
var m,o: integer;
begin
for m:=1 to n do
begin
for o:=1 to n do
begin
if(tab[m,o] < 10) then
write (' ');
write(tab[m,o]);
write (' ');
end;
writeln;
end;
end;
Procedure ensaya(var i, x, y: integer);
var k, u, v, h: integer;
begin
k:=0;
Repeat
k:=k+1;
exito:= false;
u:=x+dx[k];
v:=y+dy[k];
if ((u>=1) and (u<=n) and (v>=1) and (v<=n)) then
begin
if (tab[u,v]=0) then
begin
tab[u,v]:=i;
If (i<n*n) then
begin
h:= i + 1;
ensaya(h,u,v);
if (not exito) then
begin
tab[u,v]:=0;
end;
end
else
begin
exito:=true;
end;
end;
end
until (exito or (k=8));
end;
begin
dx[1]:=2; dx[2]:=1; dx[3]:=-1; dx[4]:=-2;
dx[5]:=-2; dx[6]:=-1; dx[7]:=1; dx[8]:=2;
dy[1]:=-1; dy[2]:=-2; dy[3]:=-2; dy[4]:=-1;
dy[5]:=1; dy[6]:=2; dy[7]:=2; dy[8]:=1;
for i:=1 to n do
for j:=1 to n do
tab[i,j]:=0;
Writeln('Problema del salto del caballo');
Writeln('Tablero: ', n,'x',n);
Writeln;
Writeln('Introduce fila inicial'); Read(i);
Writeln('Introduce columna inicial'); Read(j);
writeln;
tab[i,j]:=1;
aux:=2;
ensaya(aux,i,j);
If (exito) then
begin
writeln('SOLUCION');
mostrarTablero();
end
else
begin
writeln('No hay solucion');
end;
readkey;
end.
Problema de las N reinas:
El problema consiste en colocar n reinas en un tablero de ajedrez de dimensión n x n, sin que se den jaque (dos reinas se dan jaque si comparten fila, columna o diagonal).

El algoritmo devuelve sólo la primera solución que encuentra.

program reinas;
uses crt;
const n=8;
var x: array[1..n] of integer;
exito: boolean;
i, o, aux:integer;
function valAbs(x,y: integer):integer;
begin
if (x>y) then
begin
valAbs:=x-y;
end
else
begin
valAbs:=y-x;
end;
end;
function valido(k:integer):boolean;
var i: integer;
begin
aux:= k-1;
for i:=1 to aux do
begin
if (x[i] = x[k]) or (valAbs(x[i],x[k]) = valAbs(i,k)) then
begin
valido:=false;
exit;
end;
end;
valido:=true;
end;
procedure posicionReina(k: integer);
begin
if k>n then
begin
exit;
end;
x[k]:=0;
repeat
aux:= x[k] + 1;
x[k]:= aux;
if valido(k) then
begin
if k<>n then
begin
aux:=k+1;
posicionReina(aux);
end
else
begin
exito:=true;
end;
end;
until (x[k]=n) or exito;
end;
begin
writeln('Problema de las n reinas');
Writeln('Tablero: ', n,'x',n);
writeln();
aux:=1;
posicionReina(aux);
for i:=1 to n do
begin
for o:=1 to n do
begin
if (x[o] = i) then
begin
write('0');
end
else
begin
write('_');
end;
write(' ');
end;
writeln();
end;
readkey;
end.
Comentarios