Cod sursa(job #1608843)

Utilizator adrianneagNeag Adrian adrianneag Data 22 februarie 2016 13:44:18
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.63 kb
type multime=set of byte;
var a:array[1..20,1..20] of integer;
    s,p,c:array[1..20] of multime;
    n,nc,m:integer;
    l:multime;

    PROCEDURE citire_matrice;
    var i,j,x,y:integer;
        nume_fis:string;
        f:text;
    begin

    assign(f,'ctc.txt');reset(f);
    readln(f,n);readln(f,m);
      for i:=1 to m do
        begin
        readln(f,x,y);
        a[x,y]:=1;
        end;
    close(f);
    end;

    PROCEDURE afisare_matrice;
    var i,j:integer;
    begin
     for i:=1 to n do
       begin
         for j:=1 to n do write(a[i,j]:2);
       writeln;
       end;
    end;

    PROCEDURE formare_matrice_drumuri;
    var i,j,k:integer;
    begin
      for k:=1 to n do
        for i:=1 to n do
          for j:=1 to n do
            if a[i,j]=0 then a[i,j]:=a[i,k]*a[k,j];
    end;

    PROCEDURE det_s(i:integer);
    var k:integer;
    begin
      p[i]:=[];
      for k:=1 to n do
        if a[I,K]=1 then s[i]:=s[i]+[k];
    end;

    PROCEDURE det_p(i:integer);
    var k:integer;
    begin
    p[i]:=[];
    for k:=1 to n do
      if a[k,i]=1 then p[i]:=p[i]+[k];
    end;

    PROCEDURE det_tare_conexe;
    var i,k:integer;
    begin
     l:=[];
     nc:=0;
     for i:=1 to n do
       if not (i in l) then
         begin
          nc:=nc+1;
          det_s(i);
          det_p(i);
          c[i]:=(s[i]*p[i])+[i];
          l:=l+c[i];
          for k:=1 to n do
            if k in c[i] then write(k:3);
          writeln;
         end;
       end;
BEGIN
citire_matrice;
afisare_matrice;
formare_matrice_drumuri;
afisare_matrice;
det_tare_conexe;
end.