Cod sursa(job #1611792)

Utilizator ctsebastianCiolan-Tomus Sebastian ctsebastian Data 24 februarie 2016 14:23:52
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.08 kb
uses crt;
const inf=maxint;
type mat=array[1..20,1..20] of integer;
     vect=array[1..20] of integer;
var c:mat;d:array[1..20] of longint;
    x,i,j,k,n,m:integer;s,prec:vect;
procedure citire;
 var z,y,cost:integer;
  begin
   for i:=1 to n do
    for j:=1 to n do
     if i=j then c[i,j]:=0
            else c[i,j]:=inf;
   write('Arce: ');readln(m);
   for i:=1 to m do
    begin
     write('x',i,': ');readln(z);
     write('y',i,': ');readln(y);
     write('cost',i,': ');readln(cost);
     c[z,y]:=cost;
    end;
   write('Vf de start: ');readln(x);
  end;
procedure init;
 begin
  fillchar(s,sizeof(s),0);
  for i:=1 to n do
   begin
    d[i]:=c[x,i];
    if d[i]<inf then prec[i]:=x
                else prec[i]:=0;
   end;
  s[x]:=1;
  d[x]:=1;
  prec[x]:=0;
 end;
procedure drumuri;
 var vf,min:integer;ok:boolean;
  begin
   repeat
    ok:=false;
    min:=inf;
    for j:=1 to n do
     if (s[j]=0) and (d[j]<min) then
                                     begin
                                      ok:=true;
                                      min:=d[j];
                                      k:=j;
                                     end;
     s[k]:=1;
    for j:=1 to n do
     if (s[j]=0) and (d[k]+c[k,j]<d[j]) then
                                             begin
                                              d[j]:=d[k]+c[k,j];
                                              prec[j]:=k;
                                             end;
   until not(ok);
  end;
procedure afisare(i:integer);
 begin
  if prec[i]<>0 then
                     begin
                      afisare(prec[i]);
                      write(i,' ');
                     end;
 end;
begin
clrscr;
 citire;
 init;
 drumuri;
  for i:=1 to n do
   if i<>x then
    if d[i]=inf then writeln('Nu exista drum de la ',x,' la ',i)
     else
          begin
           writeln('Drumul minim de la ',x,' la ',i,': ');
           write(x,' ');
           afisare(i);
           writeln;
           writeln('Costul sau este: ',d[i]);
          end;
 readln;
end.