Cod sursa(job #342692)

Utilizator sapiensCernov Vladimir sapiens Data 23 august 2009 00:58:14
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.41 kb
Program dijsktra;
 type list = ^cell;
      cell = record
                no:word;
                di:longint;
                ur:list;
              end;
 var f,g:text; a:array[1..50000,1..2]of list;
     dist:array[1..50000]of longint;
     heap:array[1..50000]of word;
     ph:array[1..50000]of word;
     n,nh:word; m,i:longint;
 procedure creaza_a;
  var x:longint; y,z,w:word;
  begin
   for x:=1 to m do begin
     readln (f,y,z,w);
     a[y,2]^.no:=z;
     a[y,2]^.di:=w;
     new (a[y,2]^.ur);
     a[y,2]^.ur^.ur:=nil;
     a[y,2]:=a[y,2]^.ur;
   end;
  end;
 procedure init_heap;
  var x:longint;
  begin
   for x:=2 to n do begin
     dist[x]:=maxlongint;
     heap[x]:=x;
     ph[x]:=x;
   end;
   nh:=n;
   dist[1]:=0; heap[1]:=1; ph[1]:=1;
  end;
 procedure swap (x,y:word);
  var z:word;
  begin
   z:=heap[x]; heap[x]:=heap[y]; heap[y]:=z;
   ph[heap[x]]:=x; ph[heap[y]]:=y;
  end;
 procedure upheap (x:word);
  begin
   if ph[x]>1 then
     if dist[x]<dist[heap[ph[x] div 2]] then begin
       swap (ph[x],ph[x] div 2);
       upheap (heap[ph[x] div 2]);
     end;
  end;
 procedure downheap (x:word);
  var y:word;
  begin
   if 2*ph[x]<=nh then begin
     y:=x;
     if dist[x]>dist[heap[2*ph[x]]] then y:=heap[2*ph[x]];
     if 2*ph[x]+1<=nh then if dist[y]>dist[heap[2*ph[x]+1]] then y:=heap[2*ph[x]+1];
     if x<>y then begin
       swap (ph[x],ph[y]);
       downheap (x);
     end;
   end;
  end;
 procedure delete;
  begin
   swap (1,nh);
   dec (nh);
   downheap (heap[1]);
  end;
 function minim (x,y:longint):longint;
  begin
   if x<y then exit (x) else exit (y);
  end;
 procedure alg_dijkstra;
  var x,y:word;
  begin
   while nh>0 do begin
     x:=heap[1];
     if dist[x]=maxlongint then exit;
     delete;
     a[x,2]:=a[x,1];
     while a[x,2]^.ur<>nil do begin
       y:=a[x,2]^.no;
       if ph[y]<=nh then begin
         dist[y]:=minim (dist[y],dist[x]+a[x,2]^.di);
         upheap (y);
       end;
       a[x,2]:=a[x,2]^.ur;
     end;
   end;
  end;
 begin
  assign (f,'dijkstra.in'); reset (f);
  assign (g,'dijkstra.out'); rewrite (g);
  readln (f,n,m);
  for i:=1 to n do begin
    new (a[i,1]);
    a[i,1]^.ur:=nil;
    a[i,2]:=a[i,1];
  end;
  creaza_a;
  init_heap;
  alg_dijkstra;
  for i:=2 to n do if dist[i]<maxlongint then write (g,dist[i],' ') else write (g,'0 ');
  writeln (g);
  close (f); close (g);
 end.