Cod sursa(job #381253)

Utilizator andrei31Andrei Datcu andrei31 Data 9 ianuarie 2010 18:51:59
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.07 kb
const inf=maxint div 2;
type ref=^lista;
     lista=record
           vf,c:integer;
           leg:ref;
           end;

var g:array[1..100] of ref;
    h,d,t:array[1..100] of integer;
    n,m,x0,nv:integer;

procedure adauga(x,y,c:integer);
var p:ref;
begin
new(p);p^.vf:=y;p^.c:=c;p^.leg:=g[x];g[x]:=p;
end;

procedure citeste;
var i,x,y,c:integer;
begin
assign(input,'dijkstra.in');reset(input);
readln(n,m,x0);
for i:=1 to m do
begin
readln(x,y,c);
adauga(x,y,c);
end;
nv:=n;
close(input);
end;

procedure comb(i,n:integer);
var l,r,go,aux:integer;
begin
l:=2*i;r:=2*i+1;
go:=0;
if (l<=n) and (d[h[l]]<d[h[i]]) then go:=l;
if (r<=n) and (d[h[r]]<d[h[i]]) then go:=r;
if go>0 then begin
             aux:=h[go];
             h[go]:=h[i];
             h[i]:=aux;
             comb(go,aux);
             end;
end;

function elim:integer;
var aux:integer;
begin
elim:=h[1];
aux:=h[1];
h[1]:=h[nv];
h[nv]:=aux;
dec(nv);
end;

procedure formheap;
var i:integer;
begin
for i:=nv div 2 downto 1 do
comb(i,nv);
end;

procedure dijkstra;
var p:ref;
    i,k:integer;
begin
p:=g[x0];
for i:=1 to n do
begin
d[i]:=inf;
h[i]:=i;
end;

while p<>nil do
 begin
 d[p^.vf]:=p^.c;
 t[p^.vf]:=x0;
 p:=p^.leg;
 end;
formheap;
while nv>0 do
 begin
 k:=elim;
  p:=g[k];
 while p<>nil do begin
  if d[k]+p^.c<d[p^.vf] then  begin
                            d[p^.vf]:=d[k]+p^.c;
                            t[p^.vf]:=k;
                            end;
  p:=p^.leg;

  end;
  formheap;
 end;
end;

procedure drum(x:integer);
begin
if x<>0 then begin
                drum(t[x]);
                write(x,' ');
                end;
end;

procedure afisare;
var i:integer;
begin
assign(output,'dijkstra.out');rewrite(output);
for i:=1 to n do
if d[i]<inf then begin
                write('Drumul de la ',x0,' la ',i,' este ');
                drum(i);
                writeln;
                end
                else writeln('Nu exista drum de la ',x0,' la ',i);
close(output);
end;

begin
citeste;
dijkstra;
afisare;
end.