Cod sursa(job #1362169)

Utilizator mariusadamMarius Adam mariusadam Data 26 februarie 2015 10:48:52
Problema Componente tare conexe Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
program drumuri_infoarena;
var t,t2:array[0..1,1..400000] of longint;
    start,pred,suc,start2:array[1..100000] of longint;
    bufin,bufout:array[1..100001] of byte;
    ok:boolean;
    n,m,nr_ctc:longint;
    f,g:text;

procedure citire;
var i,j,k:longint;
begin
 readln(f,n,m);
 for k:=1 to m do
  begin
   readln(f,i,j);
   t[0,k]:=j;
   t[1,k]:=start[i];
   start[i]:=k;
   t2[0,k]:=i;
   t2[1,k]:=start2[j];
   start2[j]:=k;
  end;
end;

procedure df1(nod:longint);
var p:longint;
begin
 suc[nod]:=nr_ctc;
 p:=start[nod];
 while p<>0 do
  begin
   if suc[t[0,p]]=0 then
    df1(t[0,p]);
   p:=t[1,p];
  end;
end;

procedure df2(nod:longint);
var p:longint;
begin
 pred[nod]:=nr_ctc;
 p:=start2[nod];
 while p<>0 do
  begin
   if pred[t2[0,p]]=0 then
    df2(t2[0,p]);
   p:=t2[1,p];
  end;
end;

procedure solve;
var i,j:longint;
begin
 nr_ctc:=0;
 for i:=1 to n do
  if suc[i]=0 then
   begin
    nr_ctc:=nr_ctc+1;
    suc[i]:=nr_ctc;
    df1(i);
    df2(i);
    for j:=1 to n do
     if suc[j]<>pred[j] then
      begin
       suc[j]:=0;
       pred[j]:=0;
      end;
   end;
 writeln(g,nr_ctc);
 for i:=1 to nr_ctc do
  begin
   for j:=1 to n do
     if suc[j]=i then
      begin
       write(g,j,' ');
       ok:=true;
      end;
   if ok then
    writeln(g);
  end;
end;

begin
 assign(f,'ctc.in'); reset(f);
 assign(g,'ctc.out'); rewrite(g);
 settextbuf(f,bufin);
 settextbuf(g,bufout);
 citire;
 solve;
 close(f);
 close(g);
end.