Cod sursa(job #380694)

Utilizator cristinabCristina Brinza cristinab Data 7 ianuarie 2010 14:31:55
Problema Algoritmul lui Dijkstra Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.18 kb
{algoritmul lui dijktra- implementare folosind heapuri}
const inf=maxlongint div 2;
      n_max=50001;

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

var prim:array[1..n_max] of ref;
    d,t,h,poz:array[1..n_max] of longint;
    n,m,nh:integer;

procedure adaug(x,y,cost:integer);
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:integer;
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:integer);
var x,aux:integer;
begin
x:=h[i];
h[i]:=h[j];
h[j]:=x;
aux:=poz[h[i]];
poz[h[i]]:=poz[h[j]];
poz[h[j]]:=aux;
end;

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

procedure restaurare(n,i:integer);
var l:integer;
begin
l:=i;
if (2*i<=n)and(d[h[2*i]]<d[h[l]]) then l:=2*i;
if (2*i<n)and(d[h[2*i+1]]<d[h[l]]) then l:=2*i+1;
if i<>l then
      begin
      interschimb(l,i);
      restaurare(n,l);
      end;
end;

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

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

for i:=1 to n do
    begin
    d[i]:=inf;
    poz[i]:=i;
    h[i]:=i;
    t[i]:=0;
    end;

d[s]:=0;
interschimb(s,1);
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;
               t[p^.vf]:=nod;
               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;
dijkstra(1);
afisare;
end.