Cod sursa(job #405367)

Utilizator zseeZabolai Zsolt zsee Data 27 februarie 2010 22:09:20
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.91 kb
program Dijkstra;
type
  Pelem = ^elem;
  elem  = record
           tav:integer;
           hova:longint;
           kov:Pelem;
          end;
  grize = record
           i,dist:longint;
		  end;

var
  a: array[1..50000] of elem;
  v:array[1..50000] of grize;
  loc:array[1..50000] of longint;
  vk:longint;
  n,m:longint;
  be,ki:text;

procedure kiir;inline;
var i:longint;
begin
 for i:=2 to n do
  if loc[i]=0 then write(ki,'0 ')
   else write(ki,v[ loc[i] ].dist,' ');
 close(ki);
end;

procedure belerak(k:longint);inline;
var i:longint;
    tmp:grize;
begin
 if k=1 then exit;
 if v[k-1].dist <= v[k].dist then exit;
 i:=k-1;
 tmp:=v[k];
  while (i>=1) and ( v[i].dist > tmp.dist) do
    begin
	 v[i+1]:=v[i];
	 inc( loc[ v[i].i ] );
	 dec(i);
	end;
 v[i+1]:=tmp;
 loc[tmp.i]:=i+1;
end;

procedure olvas;inline;
var c:Pelem;
    i,x,y:longint;
    k:integer;
begin
 for i:=1 to m do
  begin
   readln(be,x,y,k);
   c:=a[x].kov;
   new(a[x].kov);
   with a[x].kov^ do
    begin
     hova:=y;
     tav:=k;
     kov:=c;
	 if x=1 then
	  begin
	   inc(vk);
	   v[vk].i:=y;
	   v[vk].dist:=k;
	   loc[y]:=vk;
	   belerak(vk);
	  end;
    end;
  end;
end;

procedure dijsktra;inline;
var k:longint;
    c:Pelem;
begin
 k:=1;
 while v[k].i <> 0 do
  begin
     c:=a[ v[k].i ].kov;
     while c <> nil do
	    begin
		  if loc[ c^.hova ] = 0 then
		         begin
				  inc(vk);
				  v[vk].i:= c^.hova;
				  v[vk].dist:= v[k].dist + c^.tav;
				  loc[c^.hova]:=vk;
				  belerak(vk);
				 end
			else
			  if v[ loc[c^.hova] ].dist > v[k].dist + c^.tav then
			     begin
				   v[ loc[c^.hova] ].dist := v[k].dist + c^.tav;
				   belerak(loc[c^.hova]);
				 end;
		   c:=c^.kov;
		end;
	 inc(k);
  end;
end;

begin
 assign(be,'dijkstra.in'); reset(be);
 assign(ki,'dijkstra.out');rewrite(ki);
 readln(be,n,m);
 olvas;
 dijsktra;
 kiir;
end.