回溯法解八皇后
发布网友
共1个回答
热心网友
用Turbo Pascal 5.0编译即可。
Program Queen(input,output);
uses
crt;
const
T=true;
F=false;
W='?;
type
a8 = array[1..8 ] of integer;
a15 = array[1..15] of integer;
Var
x,y,n,count : integer;
Col,Q : a8;
Down,Up : a15;
(* Draw a n*n board *)
Procere Draw(x:integer;y:integer;n:integer);
var
i,j : integer;
Begin
clrscr;
gotoxy(28,1);
write('** ',n,'-Queen Problem **');
gotoxy(36,2);
write('1992.10 W.Y.Z');
{draw four corners}
gotoxy(x,y);write('?);
gotoxy(x+4*n,y);write('?);
gotoxy(x+4*n,y+2*n);write('?);
gotoxy(x,y+2*n);write('?);
{Draw the border }
for i:=2 to n do
begin
gotoxy(x,y+2*(i-1)); write('?);
gotoxy(x+4*(i-1),y); write('?);
gotoxy(x+4*(i-1),y+2*n); write('?);
gotoxy(x+4*n,y+2*(i-1)); write('?);
end;
for i:=1 to n do
begin
gotoxy(x,y+2*i-1); write('?);
gotoxy(x+4*n,y+2*i-1); write('?);
gotoxy(x+4*i-3,y); write('屯?);
gotoxy(x+4*i-3,y+2*n); write('屯?);
end;
{ Draw interpoint use '? }
for i:=2 to n do
for j:=2 to n do
begin
gotoxy(x+4*(j-1),y+2*(i-1));
write('?);
end;
{ Draw horizonal line use '哪? }
for i:=2 to n do
for j:=1 to n do
begin
gotoxy(x+4*j-3,y+2*(i-1));
write('哪?);
end;
{ Draw vertical line use '? }
for i:=1 to n do
for j:=2 to n do
begin
gotoxy(x+4*(j-1),y+2*i-1);
write('?);
end;
for i:=1 to n do
begin gotoxy(x+4*n+3,y+2*i-1);write(W); end;
end;
(* Input x,y,n then Draw the board *)
Procere Board;
var
LimitX,LimitY : integer;
Begin
clrscr;
repeat {Input n}
gotoxy(5,5);
write('Enter the number of queens N(0< N ?): ');
clreol;read(n);
until (0<n) and (n<=8);
LimitX:=80-(4*n+1);LimitY:=25-(2*n-1)-5;
repeat {Input x}
gotoxy(5,10);
write('Enter X of board-up-left (0 < X ?',LimitX,'){',LimitX div 2-2,'}: ');
clreol;read(x);
until (0<x) and (x<=LimitX);
repeat {Input y}
gotoxy(5,11);
write('Enter Y of board-up-left (4骙?',LimitY,'){',(LimitY +4) div 2,'}: ');
clreol;read(y);
until (4<=y) and (y<=LimitY);
Draw(x,y,n);
gotoxy(5,24);write('Press any key to begin...');
repeat until ReadKey<>'';
gotoxy(5,24);ClrEol;
end;
(* Initiate 4 arraies: Up,Down,Col,Q *)
Procere Initiate;
var
i:integer;
Begin
for i:=1 to 2*n-1 do
begin Up[i]:=0; Down[i]:=0; end;
for i:=1 to n do
begin Col[i]:=0; Q[i]:=0; end;
count:=1;
end;
(* The function to test (tr,tc) *)
Function Test(tr,tc:integer):Boolean;
Begin
if Up[tr+tc-1]=1 then Test:=F
else if Down[tr-tc+8]=1 then Test:=F
else if Col[tc]=1 then Test:=F
else Test:=T;
end;
(* An sound procere when put a queen on (r,c) *)
Procere Laugh;
Begin
sound(150);
delay(50000);
Nosound;
delay(45000);
end;
(* Put Queen on (pr,pc) *)
Procere PutOn(pr,pc:integer);
Begin
Q[pr]:=pc; Col[pc]:=1;
Up[pr+pc-1]:=1; Down[pr-pc+8]:=1;
gotoxy(x+4*pc-2,y+2*pr-1);
write(W);
gotoxy(x+4*n+3,y+2*pr-1);write(' ');
Laugh;
end;
(* An sound procere when move a queen from (r,c) *)
Procere Cry;
Begin
sound(220);
delay(50000);
Nosound;
delay(45000);
end;
(* Move Queen from (cr,cc) *)
Procere ClrOn(cr,cc:integer);
Begin
Q[cr]:=0 ; Col[cc]:=0;
Up[cr+cc-1]:=0; Down[cr-cc+8]:=0;
gotoxy(x+4*cc-2,y+2*cr-1);
write(' ');
gotoxy(x+4*n+3,y+2*cr-1);write(W);
Cry;
end;
(* a sound procere when find a solution *)
Procere Sing;
var
i,freq:integer;
Begin
Randomize;
for i:=1 to 10 do
begin
freq:=Random(2900)+100;
Sound(freq);Delay(5000);
NoSound;
end;
end;
(* Print one solution *)
Procere PrintQ;
var
i:integer;
ch:char;
Begin
gotoxy(5,22);
write('I find the solution of NO.',count,':');
inc(count);
gotoxy(5,23);
for i:=1 to n do write(Q[i]:3);
Sing;
gotoxy(5,24);
write('Press any key to other solutions(Q to break)...');
repeat
ch:=upcase(ReadKey);
if ch='Q' then Halt(0);
until ch<>'';
gotoxy(5,24);ClrEol;
end;
(* N Queens Problem *)
Procere N_Queen(r:integer);
var
c:integer;
Begin
for c:=1 to n do
begin
if test(r,c) then
begin
PutOn(r,c);
if r=n then PrintQ
else N_Queen(r+1);
ClrOn(r,c);
end;
end;
end;
(* Print end-information of this program *)
Procere Final;
Begin
window(5,22,80,24); clrscr;
writeln('I find all of the ',count-1,' solutions !');
writeln;
write('Press any key to end.');
repeat until ReadKey<>'';
window(1,1,80,25);
end;
(* The Queen problem *)
Begin
Board;
Initiate;
N_Queen(1);
Final;
End.
