Cod sursa(job #340096)

Utilizator levap1506Gutu Pavel levap1506 Data 13 august 2009 01:42:53
Problema Algoritmul lui Dijkstra Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 2.56 kb
program dijkstra;
const inf=maxlongint;
type  vector=^nod;
      nod=record
        dest,cost:word;
        next:vector;
        end;

var a,b:text;
 j,k,aa,bb,cc,hind,S,u,vv,alt:word;
 N,M,i:longint;
 dist:array[0..50000] of longint;
 heap,poz:array[0..50000] of word;
 v:array[1..50000] of vector;
 v1:array[1..50000] of vector;
 root:vector;
 procedure push_back(aa,bb,cc:word); begin
        root:=v1[aa];
        if (root=nil) then
          begin
            new(v[aa]);
            root:=v[aa];
          end else
          begin
            new(root^.next);
            root:=root^.next;
          end;
        root^.next:=nil;
        root^.dest:=bb;
        root^.cost:=cc;
        v1[aa]:=root;
 end;
 procedure swap(i,j:word);
   var t:word;
    begin
      t:=heap[i];
      heap[i]:=heap[j];
      heap[j]:=t;
      poz[heap[i]]:=i;
      poz[heap[j]]:=j;
    end;
 procedure upheap(i:word);
   var x:word;
    begin
      x:=0;
      while (x<>i) do begin
        x:=i;
        if (dist[heap[i]]<dist[heap[i div 2]]) then i:=i div 2;
        if (i<>x) then swap(i,x);
      end;
    end;
 procedure downheap(i:word);
   var x:word;
     begin
      x:=0;
      while (x<>i) do begin
        x:=i;
        if (2*x<=hind) and (dist[heap[2*x]]<dist[heap[i]]) then i:=2*x;
        if (2*x+1<=hind) and (dist[heap[2*x+1]]<dist[heap[i]]) then i:=2*x+1;
        if (i<>x) then swap(i,x);
      end;
     end;
 procedure delete(i:word);
   begin
//     poz[heap[i]]:=-1;
     swap(hind,i);
     dec(hind);
//     downheap(i);
   end;
 begin
   dist[0]:=-1;
   assign(a,'dijkstra.in');
   assign(b,'dijkstra.out');
   reset(a);
   rewrite(b);
   Readln(a,N,M);
   s:=1;
   for i:=1 to N do
     v[i]:=nil;
   for i:=1 to M do
     begin
      Readln(a,aa,bb,cc);
      push_back(aa,bb,cc);
     end;
   hind:=N;
   for i:=1 to N do
    begin
     dist[i]:=inf;
     heap[i]:=i;
     poz[i]:=i;
    end;
   dist[S]:=0;
   upheap(poz[S]);
   while (hind>0) do
    begin
        u:=heap[1];
        if (dist[u]=inf) then break;
        delete(1);
        root:=v[u];
        while (root<>nil) do
          begin
            alt:=dist[u]+root^.cost;
            if (alt<dist[root^.dest]) then
              begin
                 dist[root^.dest]:=alt;
                 upheap(poz[root^.dest]);
              end;
            root:=root^.next;
          end;
    end;
   for i:=1 to N do
     if (i<>S) then
       if (dist[i]<>inf) then Write(b,dist[i], ' ') else write(b,0,' ');
   close(b);
 end.