Cod sursa(job #341040)

Utilizator sapiensCernov Vladimir sapiens Data 17 august 2009 13:07:49
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.43 kb
Program dijsktra;
 type vecini = ^vecin;
      vecin = record
                no:word;
                di:longint;
                ur:vecini;
              end;
 var f,g:text; a:array[1..50000,1..2]of vecini;
     heap:array[1..50000]of longint;
     b:array[1..50000]of word;
     c: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]:=a[y,2]^.ur;
   end;
  end;
 procedure init_heap;
  var x:word;
  begin
   nh:=n;
   for x:=2 to nh do begin
     heap[x]:=maxlongint;
     b[x]:=x;
     c[x]:=x;
   end;
   b[1]:=1; c[1]:=1;
  end;
 procedure swap (x,y:word);
  var z:longint;
  begin
   z:=heap[x]; heap[x]:=heap[y]; heap[y]:=z;
   b[c[x]]:=y; b[c[y]]:=x;
   z:=c[x]; c[x]:=c[y]; c[y]:=z;
  end;
 procedure upheap (x:word);
  begin
   if x>1 then if heap[x div 2]>heap[x] then begin
     swap (x div 2,x);
     upheap (x div 2);
   end;
  end;
 procedure downheap (x:word);
  var y:word;
  begin
   if 2*x<=nh then begin
     y:=x;
     if heap[2*x]<heap[y] then y:=2*x;
     if (2*x+1)<=nh then if heap[2*x+1]<heap[y] then y:=2*x+1;
     if x<>y then begin
       swap (x,y);
       downheap (y);
     end;
   end;
  end;
 procedure delete;
  begin
   swap (1,nh);
   nh:=nh-1;
   downheap (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; z:longint;
  begin
   while (nh>0) and (heap[1]<>maxlongint) do begin
     x:=c[1];
     writeln ('Nod curent: ',x);
     write ('Vecini parcursi: ');
     delete;
     a[x,2]:=a[x,1];
     while a[x,2]^.ur<>nil do begin
       y:=a[x,2]^.no;
       if b[y]<=nh then begin
         write (y,' ');
         z:=a[x,2]^.di;
         heap[b[y]]:=minim (heap[b[y]],heap[b[x]]+z);
         upheap (b[y]);
       end;
       a[x,2]:=a[x,2]^.ur;
     end;
     writeln;
   end;
  end;
 begin
  assign (f,'dijsktra.in'); reset (f);
  assign (g,'dijkstra.out'); rewrite (g);
  readln (f,n,m);
  writeln (n,' ',m);
  for i:=1 to n do begin
    new (a[i,1]);
    a[i,2]:=a[i,1];
  end;
  creaza_a;
  init_heap;
  alg_dijkstra;
  for i:=2 to n do if heap[b[i]]=maxlongint then write (g,'0 ') else write (g,heap[b[i]],' ');
  writeln (g);
  close (f); close (g);
 end.