Cod sursa(job #270721)

Utilizator philipPhilip philip Data 4 martie 2009 14:32:00
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.68 kb
const inf=1000;

type matr=array[0..10000,0..10000] of 0..1000;
     vect=array[0..50000] of longint;

var f,g:text;
    d,s,prec:vect; a:matr;
    m,n,xp,k,xf:longint;


procedure citire;
  var i,j,n1,n2,cost:longint;
  begin
    assign(f,'dijkstra.in');
    reset(f);
    readln(f,n,m);
    for i:=1 to n do begin
      for j:=1 to n do a[i,j]:=inf;
      a[i,i]:=0;
    end;
    for i:=1 to m do begin
      readln(f,n1,n2,cost);
      a[n1,n2]:=cost;
    end;
    close(f);
    xp:=1;
  end;

procedure init;
  var i:longint;
  begin
    prec[xp]:=0; s[xp]:=1;
    for i:=1 to n do begin
      d[i]:=a[xp,i];
      if (a[xp,i]<>0) and (a[xp,i]<>inf) then prec[i]:=xp;
    end;
  end;

function minim:longint;
  var min,i,p:longint;
  begin
    min:=maxint; p:=1;
    for i:=1 to n do
      if (s[i]=0) and (d[i]<min) then begin
        p:=i;
        min:=d[i];
      end;
    minim:=p;
  end;

procedure dijkstra;
  var x,i,k:longint;
  begin
    x:=0;
    repeat
      inc(x);
      k:=minim;
      s[k]:=1;
      for i:=1 to n do
        if (s[i]=0) and (d[i]>d[k]+a[k,i]) and (a[k,i]<>0) and (a[k,i]<>inf) then begin
          prec[i]:=k;
          d[i]:=d[k]+a[k,i];
        end
    until (x=n) or (d[k]=inf);
  end;

procedure afisare;
  procedure drum(i:integer);
    begin
      if i<>0 then begin
        drum(prec[i]);
        write(i);
      end;
    end;
  begin
    assign(g,'dijkstra.out');
    rewrite(g);
    for xf:=1 to n do
      if (d[xf]<>inf) and (d[xf]<>0) then begin
        write(g,d[xf],' ');
      {  drum(xf);}
      end;
    close(g);
  end;

BEGIN
  citire;
  init;
  dijkstra;
  afisare;
END.