Cod sursa(job #213469)

Utilizator RobybrasovRobert Hangu Robybrasov Data 9 octombrie 2008 21:57:48
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.66 kb
const   inf=1 shl 30;
type    adr=^noduri;
        noduri=record val:longint; cost:integer; urm:adr; end;
var     L:array[1..50000] of adr;
        H:array[1..50000] of longint;
        D:array[1..50000] of longint;
        E:array[1..50000] of boolean;
        n,m,i,j,a,b,c,min,poz,cn:longint;
        p:adr;
        f:text;

procedure combina(nod,n:longint);
var t,fiu,tata:longint;
begin
  tata:=nod;
  fiu:=nod shl 1;
  while fiu<=n do
    begin
      if D[H[fiu+1]]<D[H[fiu]] then inc(fiu);
      if H[tata]>H[fiu] then
        begin
          t:=H[tata]; H[tata]:=H[fiu]; H[fiu]:=t;
          tata:=fiu; fiu:=fiu shl 1;
        end
      else exit;
    end;
end;

procedure heap;
var i:longint;
begin
  for i:=n shr 1 downto 1 do combina(i,n);
end;

begin
  assign(f,'dijkstra.in');
  reset(f);
  readln(f,n,m);
  cn:=n;
  for i:=1 to m do
    begin
      readln(f,a,b,c);
      new(p);
      p^.val:=b; p^.urm:=L[a]; p^.cost:=c;
      L[a]:=p;
    end;
  close(f);
  p:=L[1];
  while p<>nil do
    begin
      D[p^.val]:=p^.cost;
      p:=p^.urm;
    end;
  for i:=1 to n do if D[i]=0 then D[i]:=inf;
  for i:=1 to n do H[i]:=i;
  heap;
  E[1]:=true;
  for i:=1 to n-1 do
    begin
      poz:=H[1];
      E[poz]:=true;
      for j:=1 to n do
        if not E[j] then
          begin
            p:=L[poz];
            while (p<>nil) and (p^.val<>j) do p:=p^.urm;
            if p<>nil then
              if D[poz]+p^.cost<D[j] then D[j]:=D[poz]+p^.cost;
          end;
      H[1]:=H[cn]; dec(cn);
      combina(1,cn);
    end;
  assign(f,'dijkstra.out');
  rewrite(f);
  for i:=2 to n do if D[i]<inf then write(f,D[i],' ')
                               else write(f,0,' ');
  close(f);
end.