Cod sursa(job #1367329)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 1 martie 2015 19:51:08
Problema Componente tare conexe Scor 100
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;
        ct,v,c:array of longint;
        viz:array of 0..1;
        bufin,bufout:array[1..66000] of byte;


procedure dft(nod:longint);
var     i:longint;
begin
  viz[nod]:=1;
  for i:=1 to a[nod,0] 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(b[nrc,0]);
  setlength(b[nrc],b[nrc,0]+1);
  b[nrc,b[nrc,0]]:=nod;
  for i:=1 to t[nod,0] 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(a,n+1,1);
  setlength(t,n+1,1);
  for i:=1 to m do
    begin
      readln(x,y);
      inc(a[x,0]); inc(t[y,0]);
      setlength(a[x],a[x,0]+1);
      setlength(t[y],t[y,0]+1);
      a[x,a[x,0]]:=y;
      t[y,t[y,0]]:=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
    begin
      viz[i]:=0;
    end;
  nrc:=0;
  setlength(b,n+1,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 b[i,0] do
        write(b[i,j],' ');
      writeln;
    end;
  close(input); close(output);
end.