Cod sursa(job #307386)

Utilizator mlazariLazari Mihai mlazari Data 24 aprilie 2009 07:40:53
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 3.13 kb
Program Dijkstra;
const inf=maxlongint div 2;
type PNod=^Nod;
     Nod=record
       x : longint;
       c : integer;
       next : PNod;
     end;
     Heap=record
       l : longint;
       d,r,p : array[0..50000] of longint;
     end;
var n,m : longint;
    v : array[1..50000] of PNod;
    h : Heap;
    rasp : array[1..50000] of longint;
    sel : array[1..50000] of boolean;

procedure Adauga(var p : PNod; x : longint; c : integer);
var q : PNod;
begin
  new(q);
  q^.x:=x;
  q^.c:=c;
  q^.next:=p;
  p:=q;
end;

procedure Citeste;
var Intrare : text;
    a,b,i : longint;
    c : integer;
begin
  assign(Intrare,'dijkstra.in');
  reset(Intrare);
  readln(Intrare,n,m);
  for i:=1 to n do v[i]:=nil;
  for i:=1 to m do begin
    readln(Intrare,a,b,c);
    Adauga(v[a],b,c);
  end;
  close(Intrare);
end;

function st(var h : Heap; x : longint) : longint;
begin
  if 2*x<=h.l then st:=2*x else st:=0;
end;

function dr(var h : Heap; x : longint) : longint;
begin
  if 2*x+1<=h.l then dr:=2*x+1 else dr:=0;
end;

procedure sw(var x,y : longint);
var z : longint;
begin
  z:=x;
  x:=y;
  y:=z;
end;

procedure swap(var h : heap; x,y : longint);
begin
  with h do begin
    p[r[x]]:=y;
    p[r[y]]:=x;
    sw(r[x],r[y]);
    sw(d[x],d[y]);
  end;
end;

procedure percolate(var h : Heap; x : longint);
begin
  while x div 2>0 do begin
    if h.d[x]<h.d[x div 2] then begin
      swap(h,x,x div 2);
      x:=x div 2;
    end
    else break;
  end;
end;

procedure sift(var h : Heap; x : longint);
var s,d : longint;
begin
  s:=st(h,x);
  d:=dr(h,x);
  while s>0 do begin
    if (h.d[s]<h.d[x]) or (h.d[d]<h.d[x]) then
     if h.d[s]<h.d[d] then begin
       swap(h,x,s);
       x:=s;
     end
     else begin
       swap(h,x,d);
       x:=d;
     end
    else break;
    s:=st(h,x);
    d:=dr(h,x);
  end;
end;

procedure ActualizeazaInHeap(var h : Heap; r,d1,d2 : longint);
var d : longint;
begin
  if d1<inf then d:=d1+d2 else d:=d2;
  if h.p[r]=0 then begin
    h.l:=h.l+1;
    h.p[r]:=h.l;
    h.r[h.l]:=r;
    h.d[h.l]:=d;
    percolate(h,h.l);
  end
  else
   if d<h.d[h.p[r]] then begin
     h.d[h.p[r]]:=d;
     percolate(h,h.p[r]);
   end;
end;

procedure ScoateMin(var h : Heap; var r,d : longint);
begin
  r:=h.r[1];
  d:=h.d[1];
  swap(h,1,h.l);
  h.l:=h.l-1;
  sift(h,1);
end;

procedure ActualizeazaVecini(var h : Heap; x : longint);
var q : PNod;
begin
  q:=v[x];
  while q<>nil do begin
    if not sel[q^.x] then ActualizeazaInHeap(h,q^.x,h.d[h.p[x]],q^.c);
    q:=q^.next;
  end;
end;

procedure Calculeaza;
var i,r,d : longint;
begin
  h.d[0]:=inf;
  h.l:=0;
  for i:=1 to n do begin
    h.p[i]:=0;
    sel[i]:=false;
    rasp[i]:=0;
  end;
  sel[1]:=true;
  ActualizeazaVecini(h,1);
  for i:=2 to n do begin
    ScoateMin(h,r,d);
    rasp[r]:=d;
    ActualizeazaVecini(h,r);
  end;
end;

procedure Scrie;
var Iesire : text;
    i : longint;
begin
  assign(Iesire,'dijkstra.out');
  rewrite(Iesire);
  for i:=2 to n do write(Iesire,rasp[i],' ');
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.