Cod sursa(job #1367315)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 1 martie 2015 19:37:31
Problema Componente tare conexe Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 1.71 kb
program ctc;
var     nrc,nr,i,j,x,y,n,m:longint;
        t,b,a:array of array of longint;
        cb,ct,viz,v,c:array of longint;
        bufin,bufout:array[1..400002] of byte;


procedure dft(nod:longint);
var     i:longint;
begin
  viz[nod]:=1;
  for i:=1 to c[nod] do
    if viz[a[nod,i]]=0 then
      dft(a[nod,i]);
  dec(nr);
  v[nr]:=nod;
end;

procedure df(nod:longint);
var       i:longint;
begin
  viz[nod]:=1;
  inc(cb[nrc]);
  setlength(b[nrc],cb[nrc]+1);
  b[nrc,cb[nrc]]:=nod;
  for i:=1 to ct[nod] do
    if viz[t[nod,i]]=0 then
      df(t[nod,i]);
end;

begin
  assign(input,'ctc.in'); reset(input);
  assign(output,'ctc.out'); rewrite(output);
  settextbuf(input,bufin);
  settextbuf(output,bufout);
  readln(n,m);
  setlength(viz,n+1);
  setlength(v,n+1);
  setlength(c,n+1);
  setlength(ct,n+1);
  setlength(a,n+1,1);
  setlength(t,n+1,1);
  for i:=1 to m do
    begin
      readln(x,y);
      inc(c[x]); inc(ct[y]);
      setlength(a[x],c[x]+1);
      setlength(t[y],ct[y]+1);
      a[x,c[x]]:=y;
      t[y,ct[y]]:=x;
    end;
  nr:=n+1;
  for i:=1 to n do
    if viz[i]=0 then
      dft(i);
 { for i:=1 to n do
    begin
      write(i,'->');
      for j:=1 to ct[i] do
        write(t[i,j],' ');
      writeln;
    end;   }
 { for i:=1 to n do
    write(v[i],' '); }
  for i:=1 to n do
    viz[i]:=0;
  nrc:=0;
  setlength(b,n+1,1);
  setlength(cb,n+1);
  for i:=1 to n do
    begin
      if viz[v[i]]=0 then
        begin
          inc(nrc);
          df(v[i]);
        end;
    end;
  writeln(nrc);
  for i:=1 to nrc do
    begin
      for j:=1 to cb[i] do
        write(b[i,j],' ');
      writeln;
    end;
  close(input); close(output);
end.