319
Backtracking: iesirea din labirint
>Se da un labirint sub forma de matrice cu m linii si n coloane. Fiecare element al matricei se codifica cu: 0 daca este zid si cu 1 daca este culoar. Pe unde se iese din acest labirint?
program labirint1;
uses crt;
type component=record
l,c:integer;
end;
vectsol=array[1..100]of component;
auxiliar=array[1..100]of 0..4;
labirint=array[1..25,1..25]of char;
const depl:array[1..4]of component=((l:-1;c:0),(l:0;c:1), (l:1;c:0),(l:0;c:-1));
var x:vectsol;
d:auxiliar;
tab:labirint;
n,m:integer;
l0,c0:integer;
procedure citire;
var i,j:integer;
begin
clrscr;
writeln('configuratia labirintului: ');
write('m=');readln(m);
write('n=');readln(n);
writeln('Se codifica astfel: 1-culoar; 0-zid');
for i:=1 to m do
for j:=1 to n do
begin
write('tab[',i,',',j,']=');
readln(tab[i,j]);
end;
writeln('Pozitia initiala: ');
write('l0=');readln(l0);
write('c0=');readln(c0);
x[1].l:=l0;
x[1].c:=c0;
end;
procedure INIT(k:integer);
begin
d[k]:=0;
end;
function EXISTA(k:integer):boolean;
begin
EXISTA:=d[k]<4;
end;
procedure VALPOS(k:integer);
begin
x[k].l:=x[k-1].l+depl[d[k]].l;
x[k].c:=x[k-1].c+depl[d[k]].c;
end;
function CONT(k:integer):boolean;
var i:integer;
begin
CONT:=true;
for i:=1 to k-1 do
if(x[i].l=x[k].l)and(x[i].c=x[k].c)then
CONT:=false;
with x[k] do
if tab[l,c]='0'then
CONT:=false;
end;
function SOLUTIE(k:integer):boolean;
begin
with x[k] do
SOLUTIE:= (l=1)or(c=1)or(l=m)or(c=n)
end;
procedure TIPAR(k:integer);
var i,j:integer;
begin
for i:=1 to k do
with x[i] do
write(l,' ',c, ' ');
readln;
end;
procedure BKTG;
var k:integer;
begin
k:=2;
INIT(k);
while k>1 do
if EXISTA(k)then
begin
d[k]:=d[k]+1;
VALPOS(k);
if CONT(k)then
if SOLUTIE(k)then
TIPAR(k)
else
begin
k:=k+1;
INIT(k);
end;
end
else
k:=k-1;
end;
begin
CITIRE;
BKTG;
end.
{PascalZone.uv.ro} 

