Procedure DANZIG;
var
l: array[dom,dom] of byte;
q,dv,dw,i,j,min,ind,s1,s2,dd,di: byte;
t,vs, ws, dist, drum, index : array (sir);
c: char;
function dosnotbelong(a:byte) :boolean;forward;
function nearest (a:byte) :byte;
var
k,minaux:byte;
begin
minaux:=255; nearest:=0;
for k:=1 to nr_points do
if ma[a,k]=1 then
if(l[a,k]<=minaux) and not (doesnotbelong(k)) then
begin
minaux:=l[a,k]; nearest:=k, min:= minaux;
end;
procedure minim (dist:array; var min:byte; var ind:byte);
var
k:byte;
begin
min:=255; ind:=1;
for k:=1 to dv do
if (dist[k]<=min) then
if (dist[k]>0) then
begin
min:=dist[k]; ind:=k;
end;
end;
procedure distante (var dist:array);
var
k:=byte;
begin
for k:=1 to dv do
if ws[k]>0 then
dist[k]:=t[vs[k]+l[vs[k],ws[k]]
else dist[k]:=0;
end;
function doesnotbelong(a:byte):boolean;
var
bol:boolean;
k;byte;
begin
bol:=false;
for k:=1 to dv do
if a=vs[k] then bol:=true;
doesnotbelong:=bol;
end;
procedure write(fin:byte; dist:array; dim:byte);
var
k:byte;
begin
dw:=1; dist[1]:fin; k:=fin;
repeat
inc(dw); k:=index[k]; dist[dw]:=k;
until index[k]=0;
for k:=dw downto 1 do
write(dist[k], '');
end;
procedure Dant(nr_points:byte; var t:array);
var i,j:byte;
l:array[dom,dom] of longint; {BK}
begin
dv:=1; dw:=1; vs[dv]:=1; t[1]:=0;
for i:=1 to nr_points-1 do
begin
for j:=1 to dv do ws[j]:=nearest(vs[j]);
distante(dist);
minim(dist,min,ind);
inc(dv);vs[dv]:=ws[ind];
t[ws[ind]:=min; index[ws[ind]]:=vs[ind];
end;
end;
procedure read_data;
var
a1,a2,i,j:byte;
begin
writeln('type the distances: ');
for i:=1 to nr_points do
for j:=1 to nr_points do
if ma[i,j]=1 then
begin
repeat
write('Distance from ',i,'to ',j,' is: ');
readln(l[i,j]);
if l[i,j]<=0 then
begin
write ('INCORECT LENGHT! ');
end;
until l[i,j]>0
end;
end;
begin
read_data;
Dant(nr_points,t);
for i:=2 to nr_points do
begin
if t=0 then
begin
writeln('There is no road from 1 to ',i)
end
else
begin
writeln('The distance from 1 to ',i,' is: ', t);
writeln('The road from ',1,' to ',i,' is: ');
write(i,dist,dw);
end;
end;
repeat until keypressed;
end;
