Cod sursa(job #1608898)

Utilizator razvano121Turza Razvan razvano121 Data 22 februarie 2016 13:54:44
Problema Componente tare conexe Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 2.44 kb
type multime=set of byte;
     matrice=array[1..1000,1..1000] of integer;
var a:matrice;
    l:multime;
    s,p,c:array[1..1000] of multime;
    n,nc,m:integer;
procedure citire(var a:matrice);
        var i,j,k,x,y:integer;
            f:text;
        begin
        assign(f,'ctc.in');reset(f);
        readln(f,n,m);
        for i:=1 to n do
                for j:=1 to n do
                        a[i,j]:=0;
        for k:=1 to m do
                begin
                readln(f,x,y);
                a[x,y]:=1;
                end;
        close(f);
        end;
procedure r_w(var a:matrice);
        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
        s[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 comp_conexe;
        var i,k:integer;
            g:text;
        begin
        assign(g,'ctc.out');rewrite(g);
        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];
                                     end;
        writeln(g,nc);
        nc:=0; l:=[];
        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
                                        begin
                                        if k in c[i] then write(g,k,' ');
                                        end;
                                        writeln(g);
                                     end;

        close(g);
        end;
BEGIN
citire(a);
r_w(a);
comp_conexe;
END.