Cod sursa(job #329579)

Utilizator levap1506Gutu Pavel levap1506 Data 6 iulie 2009 17:20:23
Problema Algoritmul lui Dijkstra Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 3.79 kb
program dijkstra;
 type list=^nod;
      nod=record
       i:longint;
       dist:longint;
       next:list;
       end;
 var a,b:text;
  i,j,k,x,y,dist,source,n,indicator,u,alt,sind,indicator2:longint;
  r,r1:list;
  zx:array[1..2] of longint;
  z:array[1..50000] of list;
  heap:array[1..50000,1..2] of longint;
  disttt:array[1..50000] of longint;
  procedure swap(i,j:longint);
   var zx:array[1..2] of longint;
   begin
      zx:=heap[i];
      heap[i]:=heap[j];
      heap[j]:=zx;
   end;
  procedure insert(x,y,dist:longint);
  var r:list;
   begin
    if z[x]=nil
     then
      begin
       new(z[x]);
       z[x]^.i:=y;
       z[x]^.dist:=dist;
       z[x]^.next:=nil;
       exit;
      end;
      r:=z[x];
     while r^.next<>nil do
      r:=r^.next;
     new(r^.next);
     r:=r^.next;
     r^.i:=y;
     r^.dist:=dist;
     r^.next:=nil;
   end;
  procedure insert_heap(distance,node:longint);
  var zx:array[1..2] of longint;
     sind:longint;
   begin
    inc(indicator);
    sind:=indicator;
    heap[sind,1]:=distance;
    heap[sind,2]:=node;
    while not((sind div 2=0) or (heap[sind div 2,1]<=heap[sind,1])) do
     begin
     swap(sind,sind div 2);
     sind:=sind div 2;
     end;
   end;
  procedure delete_heap(i:longint);
   var sind:longint;
   zx:array[1..2] of longint;
   begin
    heap[i]:=heap[indicator];
    heap[indicator,1]:=0;
    heap[indicator,2]:=0;
    dec(indicator);
    sind:=indicator;
    if 2*i+1>50000 then exit;
     if (heap[2*i,1]+heap[2*i+1,1])>0 then
    while ((heap[i,1]>heap[2*i+1,1]) and (heap[2*i+1,1]>0)) or ((heap[i,1]>heap[2*i,1]) and (heap[2*i,1]>0))do
     begin
     if (heap[2*i,1]<>0) and (heap[2*i+1,1]<>0) then
      if (heap[2*i,1]>heap[2*i+1,1]) then sind:=2*i+1 else sind:=2*i
       else

           if heap[2*i,1]>0 then sind:=2*i else sind:=2*i+1;
           swap(sind,i);
      i:=sind;
     end;
   end;
  function distt(u:longint; var poz:longint):longint;
  var i:longint;
   begin
   j:=-1;
    for i:=1 to indicator do
        if heap[i,2]=u then begin poz:=i; exit(heap[i,1]); end;
        distt:=disttt[u];
   end;
  begin
   assign(a,'dijkstra.in');
   assign(b,'dijkstra.out');
   reset(a);
   rewrite(b);
    Readln(a,k,n);
   for i:=1 to k do
    z[i]:=nil;
   for i:=1 to n do
    begin
    Readln(a,x,y,dist);
    insert(x,y,dist);
    end;
    indicator:=0;
   source:=1;
   insert_heap(0,source);
   for i:=1 to k do
    if i=source then continue else insert_heap(maxlongint div 2,i);
   while indicator<>0 do
    begin
    Writeln(indicator);
       u:=heap[1,2];
       if distt(u,j)=maxlongint div 2 then break;
       disttt[heap[1,2]]:=heap[1,1];
       inc(indicator2);
       delete_heap(1);

       r:=z[u];
       while r<>nil do
        begin
         alt:=distt(u,j)+r^.dist;
         r1:=r;
         r:=r^.next;

         if alt<distt(r1^.i,j) then
          begin
           heap[j,1]:=alt;
           sind:=j;
           if j<0 then continue;
    while not((sind div 2=0) or (heap[sind div 2,1]<=heap[sind,1])) do
     begin
      zx:=heap[sind div 2];
      heap[sind div 2]:=heap[sind];
      heap[sind]:=zx;
      sind:=sind div 2;
     end;
     if 2*j+1>50000 then continue;
     if heap[2*j,1]+heap[2*j+1,1]>0 then
    while ((heap[j,1]>heap[2*j+1,1]) and (heap[2*j+1,1]>0)) or ((heap[j,1]>heap[2*j,1]) and (heap[2*j,1]>0))do
     begin
     if heap[2*j,1]*heap[2*j+1,1]>0 then
      if (heap[2*j,1]>heap[2*j+1,1]) then sind:=2*j+1 else sind:=2*j
       else

           if heap[2*j,1]>0 then sind:=2*j else sind:=2*j+1;
      zx:=heap[j];
      heap[j]:=heap[sind];
      heap[sind]:=zx;
      j:=sind;
     end;

          end;
    end;
    end;
    for i:=2 to k do
     Write(b,disttt[i],' ');
     close(b);
  end.