Cod sursa(job #568599)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 31 martie 2011 14:46:28
Problema Algoritmul lui Dijkstra Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.65 kb
type muchie = ^nod;
     nod = record n:word; c:integer; a:muchie; end;

var v:array[1..2, 1..250000] of muchie;
    d:array[1..50000] of longint;
    poz:array[0..50000] of word;
    arb:array[0..50000] of record y:word; c:longint; end;
    buf1, buf2:array [1.. 1 shl 20] of char;
    aux:longint;
    x, y, c, m, n, i, j, an:longint;
    ok:boolean;
    p, r:muchie;
    f, g:text;

procedure inheap (a:longint);
  begin
  while (arb[a].c<arb[a div 2].c) and (a>1) do
    begin
    aux:=arb[a].y; arb[a].y:=arb[a div 2].y; arb[a div 2].y:= aux;
    aux:=arb[a].c; arb[a].c:=arb[a div 2].c; arb[a div 2].c:= aux;
    aux:=poz[arb[a].y]; poz[arb[a].y]:=poz[arb[a div 2].y]; poz[arb[a div 2].y]:=aux;
    a:=a div 2;
    end;
  end;

procedure exheap (a:longint);
var b:longint;
  begin
  b:=1;
  while b<>0 do
    begin
    b:=0;
    if a*2<=an then
      begin
      b := a*2;
      if (a*2+1<=an) then if (arb[a*2+1].c<arb[a*2].c) then b:=a*2+1;
      end;
    if arb[a].c<arb[b].c then b:=0;
    if b<>0 then
      begin
      aux:=arb[a].y; arb[a].y:=arb[b].y; arb[b].y:= aux;
      aux:=arb[a].c; arb[a].c:=arb[b].c; arb[b].c:= aux;
      aux:=poz[arb[a].y]; poz[arb[a].y]:=poz[arb[b].y]; poz[arb[b].y]:=aux;
      a:=b;
      end;
    end;
  end;

begin
assign (f, 'dijkstra.in'); settextbuf (f, buf1); reset (f);
assign (g, 'dijkstra.out'); settextbuf (g, buf2); rewrite (g);

read (f, n, m);
an:=0;
for i := 2 to n do
  begin
  d[i]:=maxlongint;
  an:=an+1;
  arb[an].y:=i;
  arb[an].c:=d[i];
  poz[i]:=an;
  end;

for i := 1 to m do
  begin
  read (f, x, y, c);
  if v[1, x]<>nil then
    begin
    p:=v[2, x];
    while p^.a <> nil do p:=p^.a;
    new (r); r^.n:=y; r^.c:=c; r^.a := nil; p^.a:=r; v[2, x]:=r;
    end
                   else
    begin
    new(v[1, x]); v[1, x]^.n:=y; v[1, x]^.c:= c; v[1, x]^.a := nil; v[2, x]:=v[1, x];
    end;
  end;

p:=v[1, 1];
while p <> nil do
  begin
  d[p^.n]:=p^.c;
    if poz[p^.n]<=an then
    begin
    arb[poz[p^.n]].c:=p^.c;
    inheap(poz[p^.n]);
    end;
  p:=p^.a;
  end;

while an >0 do
  begin
  x:=arb[1].y;
  poz[arb[1].y]:=an;
  poz[arb[an].y]:=1;
  arb[1].y:=arb[an].y;
  arb[1].c:=arb[an].c;
  an:=an-1;
  exheap (1);

  p:=v[1, x];
  while p <> nil do
    begin
    if d[p^.n]>d[x]+p^.c then
      begin
      d[p^.n]:=d[x]+p^.c;
      arb[poz[p^.n]].c:=d[p^.n];
      inheap(poz[p^.n]);
      end;
    p:=p^.a;
    end;
  if d[arb[1].y]=maxlongint then an:=0;
  end;

for i := 2 to n do
  begin
  if d[i] =maxlongint then write (g, '0 ')
                      else write (g, d[i], ' ');
  end;

close (f); close (g);
end.