Problema Comis Voiajerului

 

Program ComisVoiajer; 

var sol, optim:array[1..100] of integer;

distanta:array[1..100,1..100]of integer;

n,dist,dist_min:integer;

exista_solutie:boolean;

i,j,m,ooo,oooo,lung:integer;

procedure solutie;

var k:integer;

begin

dist:=0;

for k:=1 to n do

dist:=dist+distanta[sol[k],sol[k+1]];

if not exista_solutie or (dist<dist_min) then begin

exista_solutie:=true;

dist_min:=dist;

for k:=1 to n+1 do

optim[k]:=sol[k];

end; end;

function continuare(i:integer):boolean;

var k:integer;

begin

if ((i=1) and (sol[1]<>1)) or ((i=n+1) and (sol[n+1]<>1)) or

((i>1) and (distanta [sol[i-1], sol[i]]=0)) then begin

continuare:=false;

exista_solutie:=false; end;

if (i=n+1)then begin

continuare:=true;

exista_solutie:=true; end;  k:=i-1;

while(k>=0) and (sol[i]<> sol[k]) do dec(k);

continuare:=not(k>=0); end;

procedure backtracking_recursiv(i:integer);

var k:integer;

begin

if i=n+2 then  solutie

else begin for k:=1 to n do begin

sol[i]:=k;

if continuare(i) then  backtracking_recursiv(i+1); 

end; end; end;

procedure backtracking_nerecursiv;

var i:integer;

begin

for i:=1 to n+1 do

sol[i]:=0;

i:=1;

while(i>0) do begin

if (i=n+2) then begin

solutie;

dec(i);

end else begin

inc(sol[i]);

if (sol[i]>n) then begin

sol[i]:=0;

dec(i);

end else begin

if continuare(i) then

inc(i);

end; end; end; end;

procedure afiseaza_solutie;

var k:integer;

begin

if not exista_solutie then

writeln('Nu exista solutie!')

else begin

for k:=1 to n+1 do

write(optim[k],' ');

writeln('lungime:',dist_min);

end; end;

begin

write('Numarul de orase:');

readln(n);

write('Numarul de drumuri:');

readln(m);

for i:=1 to n do 

for j:=1 to m do begin

write('oras1 oras2 lungime:');

readln(ooo,oooo,lung);

distanta[ooo,oooo]:=lung;

end;

exista_solutie:=false;

writeln('Backtracking recursiv:');

backtracking_recursiv(1);

afiseaza_solutie;

exista_solutie:=false;

writeln('Backtracking nerecursiv:');

backtracking_nerecursiv;

afiseaza_solutie; 

end.