Cod sursa(job #1362076)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 26 februarie 2015 10:17:45
Problema Floyd-Warshall/Roy-Floyd Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.19 kb
program info;
var f:text;
   z:array[1..100] of 0..1;
   a,b:array[1..100,1..100] of integer;
   m,i,j,k,x,u,z:integer;
       gasit:boolean;
procedure citire;
var z:integer;
begin
     assign(f,'date.in');
     reset(f);
        readln(f,n);
          for i:=1 to n do
            for j:=1 to n do
               if i=j then
                  a[i,j]:=0
                else
              a[i,j]:=-maxint;
             while not eof(f) do
                begin
                   readln(f,x,y,z);
                     a[x,y]:=z;
                end;
            close(f);
end;
procedure df(nod:integer);
var k:integer;
   ok:boolean;
begin
     ok:=true;
     t[nod]:=1;
       for k:=1 to n do
          if (a[nod,k]<>-maxint) and (k<>nod) then
            begin
               ok:=false;
                 if t[k]=0 then
                    df(k);
                       gasit:=true;
             end;
                if ok=true then
                    z[nod]:=0;
end;
procedure roy;
begin
     for k:=1 to n do
       for i:=1 to n do
         for j:=1 to n do
            if (k<>i) and (k<>j) then
              if (b[i,j]<b[i,k]+b[k,j]) then
                  b[i,j]:=b[i,k]+b[k,j];
end;
procedure drum (x,y:integer);
var k:integer;
  gasit:boolean;
begin
     k:=1;
        gasit:=false;
          while (k<=n) and (not gasit) do
             begin
                 if (x<>k) and (y<>k) then
                   if b[x,y]=b[x,k]+b[k,y] then
                    begin
                      drum(x,k);
                      drum(k,y);
                      gasit:=true;
                    end;
                k:=k+1;
             end;
          if not gasit then
             write(y,' ');
end;
begin
       write;
       b:=a;
         gasit:=false;
           df(1);
              if gasit then
                 writeln('este ciclu')
               else
            begin
              roy;
              writeln('dati x');
              readln(x);
              writeln('dati y');
              readln(y)
              writeln('lungimea drumului este', b[x,y]);
              write(x,' ');
              drum(x,y);
           end;
end.