Cod sursa(job #379634)

Utilizator cristinabCristina Brinza cristinab Data 2 ianuarie 2010 19:52:17
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.46 kb
{algoritmul lui dijkstra- implementare folosind heapuri}
const inf=maxlongint div 2;

type ref=^nod;
     nod=record
         vf:longint;
         c:integer;
         leg:ref;
         end;

var prim:array[1..50010] of ref;
    d,h,poz:array[0..50010] of longint;
    n,m,nh:longint;

procedure adaug(x,y,cost:longint);
var c:ref;
begin
new(c);
c^.vf:=y;
c^.c:=cost;
c^.leg:=prim[x];
prim[x]:=c;
end;

procedure citire;
var x,y,cost,i:longint;
begin
assign(input,'dijkstra.in'); reset(input);
readln(n,m);
for i:=1 to m do
    begin
    readln(x,y,cost);
    adaug(x,y,cost);
    end;
close(input);
end;


procedure interschimb(i,j:longint);
var x:longint;
begin
x:=h[i];
h[i]:=h[j];
h[j]:=x;
poz[h[i]]:=i;
poz[h[j]]:=j;
end;

procedure restaurare(r,k:longint); //r=radacina k=nr elemente din heap
var i,st,dr:longint;
begin
if 2*r+1<=k then
   begin
   st:=h[2*r+1];
   if 2*r+2<=k then dr:=h[2*r+2]
               else dr:=st-1;
   if st>dr then i:=2*r+1
            else i:=2*r+2;
   if d[h[r]]>d[h[i]] then
      begin
      interschimb(r,i);
      restaurare(i,k);
      end;
   end;
end;

procedure urca(k:longint);
var t:longint;
begin
if k>0 then
   begin
   t:=(k-1) div 2;
   if d[h[k]]<d[h[t]] then
      begin
      interschimb(k,t);
      urca(t);
      end;
   end;
end;


function scoateheap:longint;
begin
interschimb(0,nh);
poz[h[nh-1]]:=0;
dec(nh);
restaurare(0,nh);
scoateheap:=h[nh];
end;

procedure formareheap(k:longint);
var i:longint;
begin
for i:=1 to k-1 do urca(i);
end;

procedure initializari;
var i:longint;
begin
//initializari
for i:=0 to 50010 do d[i]:=inf;

for i:=0 to n-1 do
    begin
    poz[i+1]:=i;
    h[i]:=i+1;
    end;
end;

procedure dijkstra(s:longint);
var i,nod:longint;
    p:ref;
begin

d[s]:=0; //drumu de la sursa la sursa
formareheap(n);
nh:=n;

while nh>0 do
      begin
      nod:=scoateheap;
      p:=prim[nod];

      while p<>nil do
            begin
            if d[p^.vf]>d[nod]+p^.c then
               begin
               d[p^.vf]:=d[nod]+p^.c;
               urca(poz[p^.vf]);
               end;
            p:=p^.leg;
            end;
      end;
end;

procedure afisare;
var i:longint;
begin
assign(output,'dijkstra.out'); rewrite(output);
for i:=2 to n do
    if d[i]=inf then write(0,' ')
                else write(d[i],' ');
close(output);
end;

begin
citire;
initializari;
dijkstra(1);
afisare;
end.