Cod sursa(job #437507)

Utilizator jiangweipirlo andrea jiangwei Data 9 aprilie 2010 20:24:51
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.49 kb
const
  tfi = 'dijkstra.in';
  tfo = 'dijkstra.out';
  maxn  = 100001;
  maxc  = 1000000000;
var
  fi,fo : text;
  n,m,nheap,kq : longint;
  free  :array[0..maxn] of boolean;
  h,d,vt,heap : array[0..maxn] of longint;
  c,ke : array[0..maxn*10] of longint;
  ds  : array[1..3,0..maxn*5] of longint;
{-----}
procedure nhap;
var
  i,u,v,l : longint;
begin
  assign(fi,tfi); reset(fi);
  readln(fi,n,m);
  for i := 1 to m do
    begin
      readln(fi,u,v,l);
      ds[1][i] := u; ds[2][i] := v; ds[3][i] := l;
      inc(h[u]); inc(h[v]);
    end;
  close(fi);
end;
{-----}
procedure ktao;
var
  i,u,v,l : longint;
begin
  kq := 0; nheap := 0;
  for i := 1 to n + 1 do h[i] := h[i-1] + h[i];
  for i := 1 to m do
    begin
      u := ds[1][i]; v := ds[2][i]; l := ds[3][i];
      ke[h[u]] := v; ke[h[v]] := u; c[h[u]] := l; c[h[v]] := l;
      dec(h[u]); dec(h[v]);
    end;
  fillchar(free,sizeof(free),true);
end;
{-----}
procedure Push(v : longint);
var
  con,cha : longint;
begin
  if vt[v] = 0 then
    begin
      inc(nheap);
      vt[v] := nheap;
    end;
  con := vt[v];
  cha := con div 2;

  while (cha > 0) and (d[v] < d[heap[cha]]) do
    begin
      heap[con] := heap[cha];
      vt[heap[con]] := con;
      con := cha;
      cha := con div 2;
    end;

  heap[con] := v;
  vt[v] := con;
end;
{-----}
function Pop : longint;
var
  u,con,cha : longint;
begin
  pop := heap[1];
  u := heap[nheap]; dec(nheap);
  cha := 1;
  while cha * 2 <= nheap do
    begin
      con := cha * 2;
      if (con < nheap) and (d[heap[con]] > d[heap[con+1]]) then con := con + 1;
      if d[u] <= d[heap[con]] then break;
      heap[cha] := heap[con];
      vt[heap[cha]] := cha;
      cha := con;
    end;
  heap[cha] := u;
  vt[u] := cha;
end;
{-----}
procedure DijkstraHeap;
var
  i,u,v : longint;
begin
  for i := 1 to n do d[i] := maxc;
  d[1] := 0; free[1] := false;
  Push(1);
  repeat
    u := pop;
    for i := h[u] + 1 to h[u+1] do
      begin
        v := ke[i];
        if free[v] and (d[u] + c[i] < d[v]) then
          begin
            d[v] := d[u] + c[i];
            Push(v);
          end;
      end;
  until nheap = 0;
end;
{-----}
procedure xuly;
begin
  DijkstraHeap;
end;
{-----}
procedure inkq;
var
  i : longint;
begin
  assign(fo,tfo); rewrite(fo);
  for i := 2 to n do
    if d[i] = maxc then write(fo,0,' ')
    else write(fo,d[i],' ');
  close(fo);
end;
{-----}
BEGIN
  nhap;
  ktao;
  xuly;
  inkq;
END.