Cod sursa(job #560916)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 18 martie 2011 19:08:17
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.48 kb
type muchie = ^nod;
     nod = record n:longint; c:integer; a:muchie; end;

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

procedure inheap (a:longint);
  begin
  if a<> 1 then
  begin
  while (arb[a].c<arb[a div 2].c) and (a<>1) do
    begin
    aux.y:=arb[a].y; arb[a].y:=arb[a div 2].y; arb[a div 2].y:= aux.y;
    aux.c:=arb[a].c; arb[a].c:=arb[a div 2].c; arb[a div 2].c:= aux.c;
    a:=a div 2;
    end;
  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) and (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.y:=arb[a].y; arb[a].y:=arb[b].y; arb[b].y:=aux.y;
      aux.c:=arb[a].c; arb[a].c:=arb[b].c; arb[b].c:=aux.c;
      a:=b;
      end;
    end;
  end;



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

read (f, n, m);

for i := 2 to n do d[i]:=maxlongint;
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]; an:=0;
for i := 1 to v[1, 1]^.n do
  begin
  p:=p^.a;
  d[p^.n]:=p^.c;
  an:=an+1; arb[an].y:=p^.n; arb[an].c:=p^.c;
  inheap(an);
  end;
s[1]:=true;

while an >0 do
  begin
  ok := true;
  while ok and (an>0) do
    begin
    if s[arb[1].y] = false then
      begin
      ok:= false;
      x:=arb[1].y;
      s[x]:=true;
      end;
    arb[1].y:=arb[an].y; arb[1].c:=arb[an].c; an:=an-1;
    exheap(1);
    end;
  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 d[p^.n]:=d[x]+p^.c;
    if s[p^.n] = false then
      begin
      an:=an+1; arb[an].y:=p^.n; arb[an].c := p^.c;
      inheap(an);
      end;
    end;
  end;

for i := 2 to n do write (g, d[i], ' ');

  {
for i := 1 to n do
  begin
  p:=v[1, i];
  for j := 1 to v[1, i]^.n do
    begin
    p:=p^.a;
    writeln (i, ' ', p^.n, ' ', p^.c);
    end;
  end;
  }
close (f); close (g);
end.