Cod sursa(job #407240)

Utilizator saodem74hieu tran saodem74 Data 2 martie 2010 10:22:52
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 2.17 kb
uses  math;
const   tfi='dijkstra.in';
        tfo='dijkstra.out';
        maxn=50550;
        maxm=250250;
        maxv=2000000000;
type    li=record
            u,v,x:longint;
          end;
var     fi,fo:text;
    nh,n,m:longint;
    st,ke,c:array[0..maxm] of longint;
    ds:array[0..maxm] of li;
    heap,vt,f:array[0..maxn] of longint;

procedure enter;
var i,j:longint;
begin
  read(fi,n,m);
  for i:=1 to m do
   with ds[i] do
    begin
     read(fi,u,v,x);
     inc(st[u]);
    end;
   inc(st[1]);
   for i:=2 to n+1 do st[i]:=st[i]+st[i-1];
   for i:=1 to m do
    with ds[i] do
     begin
      dec(st[u]);
      ke[st[u]]:=v;
      c[st[u]]:=x;
     end;
end;

procedure swap(var u,v:longint);
var tg:longint;
begin
  tg:=u; u:=v ; v:=tg;
end;


procedure push(u:longint);
var cha,con:longint;
begin
  if vt[u]=0 then
   begin
    inc(nh);
    heap[nh]:=u;
    vt[u]:=nh;
   end;
  con:=vt[u];
  cha:=con div 2;
  while (cha<>0) and (f[heap[cha]]>f[heap[con]]) do
   begin
    swap(heap[cha],heap[con]);
    vt[heap[con]]:=con;
    vt[heap[cha]]:=cha;
    con:=cha;
    cha:=con div 2;
   end;
end;

function Pop:longint;
var cha,con:longint;
begin
  pop:=heap[1];
  heap[1]:=heap[nh];
  vt[heap[1]]:=1;
  dec(nh);
  cha:=1; con:=cha*2;
  while con<=nh do
   begin
    if con<nh then
     if f[heap[con]]>f[heap[con+1]] then inc(con);
    if f[heap[con]]>=f[heap[cha]] then exit;
    swap(heap[cha],heap[con]);
    vt[heap[con]]:=con;
    vt[heap[cha]]:=cha;
    cha:=con;
    con:=cha*2;
   end;
end;

procedure process;
var u,v,i,j:longint;
begin
  fillchar(f,sizeof(f),127);
  fillchar(vt,sizeof(vt),0);
  f[1]:=0;
  nh:=0;
  push(1);
  repeat
        u:=pop;
        for v:=st[u] to st[u+1]-1 do
         if f[ke[v]]>f[u]+c[v] then
          begin
           f[ke[v]]:=f[u]+c[v];
           push(ke[v]);
          end;
  until nh=0;
end;

procedure print;
var i:longint;
begin
  for i:=2 to n do
   if f[i]>maxv then write(fo,0,' ')
    else write(fo,f[i],' ');
end;

begin
  assign(fi,tfi); reset(fi);
  assign(fo,tfo); rewrite(fo);
  enter;
  process;
  print;
  close(Fi); close(Fo);
end.