Cod sursa(job #1660414)

Utilizator robertadRoxana Rodile robertad Data 23 martie 2016 06:58:31
Problema Componente tare conexe Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.61 kb
program tareconexe;
var f,g:text;
    bufin,bufout:array[1..1 shl 17] of char;
    n,m,i,j,nrc:longint;
    a:array of array of byte;
    suc,pred:array of longint;
procedure citire;
var i,j,k:longint;
  begin
    assign(f,'ctc.in');
    assign(g,'ctc.out');
    settextbuf(f,bufin);
    settextbuf(g,bufout);
    reset(f);
    rewrite(g);
    readln(f,n,m);
    setlength(a,n+10,n+10);
    setlength(suc,n*10);
    setlength(pred,n*10);
    for k:=1 to m do
      begin
        readln(f,i,j);
        a[i,j]:=1;
      end;
  end;
procedure df1(nod:longint);
var k:longint;
  begin
    suc[nod]:=nrc;
    for k:=1 to n do
      if (a[nod,k]=1) and (suc[k]=0) then
                                     df1(k);
  end;
procedure df2(nod:longint);
var k:longint;
  begin
    pred[nod]:=nrc;
    for k:=1 to n do
      if (a[k,nod]=1) and (pred[k]=0) then
                                      df2(k);
  end;
begin
 citire;
 nrc:=1;
 for i:=1 to n do
   if suc[i]=0 then
               begin
                 suc[i]:=nrc;
                 df1(i);
                 df2(i);
                 for j:=1 to n do
                   if suc[j]<>pred[j] then
                                      begin
                                        suc[j]:=0;
                                        pred[j]:=0;
                                      end;
                   nrc:=nrc+1;
               end;
 nrc:=nrc-1;
 writeln(g,nrc);
 for i:=1 to nrc do
   begin
     for j:=1 to n do
       if suc[j]=i then
                   write(g,j,' ');
     writeln(g);
   end;
   close(f);
   close(g);
end.