Cod sursa(job #929085)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 20:35:34
Problema Algoritmul Bellman-Ford Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
program saddasdasdasd;
type vect=array[1..1000]of integer;
     mat=array[1..1000,1..1000]of integer;
const infinit=maxint;
var d,pre,m,dr:vect;c:mat;
    n,nr_m,cost,i,j,k,x,y,start,dmin,lg,vfmin,solutie:integer;
    f,g:text;

procedure initializare;
begin
readln(f,n,nr_m);start:=1;
solutie:=1;
for i:=1 to n do
 for j:=1 to n do begin c[i,j]:=infinit; c[j,i]:=infinit;end;
for i:=1 to nr_m do begin
                    readln(f,x,y,cost);
                    c[x,y]:=cost;
                    end;
for i:=1 to n do begin d[i]:=c[start,i]; pre[i]:=start;end;
fillchar(m,n,0);
m[start]:=1;pre[start]:=0;
end;

procedure bellman(var solutie:integer);
begin
solutie:=1;
for i:=1 to n do
 for j:=1 to n do
   for k:=1to n do
     if (c[j,k]=infinit)and(d[k]>d[j]+c[j,k]) then begin
                                                   d[k]:=d[j]+c[j,k];
                                                   pre[k]:=j;
                                                   end;
for j:=1 to n do
  for k:=1 to n do
    if (c[j,k]<>infinit)and(d[k]>d[j]+c[j,k]) then solutie:=0;
end;

procedure afiseaza;
begin
for i:=1 to n do
if i<>start then begin
                 writeln(g,'Costul drumului de cost minim de la ',start,' la ',i,' este: ',d[i]);
                 writeln(g,'Drumul de cost minim:');
                 dr[0]:=i; lg:=0;
                 while pre[dr[lg]]<>0 do
                      begin
                      inc(lg);
                      dr[lg]:=pre[dr[lg-1]];
                      end;
                  for j:=lg downto 0 do write(g,dr[j],' ');
                  writeln(g);
                  end;
end;

begin
assign(f,'bellman.in');reset(f);
assign(g,'bellman.out');rewrite(g);
initializare;
bellman(solutie);
afiseaza;
close(f);close(g);
end.