Cod sursa(job #568596)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 31 martie 2011 14:37:54
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 2.58 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 17] 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 n do begin new(v[1, i]); v[1, i]^.n:=0; end;
for i := 1 to m do
  begin
  read (f, x, y, c);
  if v[1, x]^.n=0 then p:=v[1, x]
                  else p:=v[2, x];
  new (r); r^.n:=y; r^.c:=c; p^.a:=r; v[2, x]:=r;
  inc(v[1, x]^.n)
  end;

p:=v[1, 1];
for i := 1 to v[1, 1]^.n do
  begin
  p:=p^.a;
  d[p^.n]:=p^.c;
    if poz[p^.n]<=an then
    begin
    arb[poz[p^.n]].c:=p^.c;
    inheap(poz[p^.n]);
    end;
  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];
  for i := 1 to v[1, x]^.n do
    begin
    p:=p^.a;
    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;
    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.