Cod sursa(job #895535)

Utilizator mada0222Tomus Madalina mada0222 Data 27 februarie 2013 11:43:32
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
program asfsdf;
var f,g:text;
n,m,i,j,x,y,nr,a2,c:longint;
a,t:array of array of longint;
viz,post,viz1:array of longint;
bufin,bufout:array[1..65000] of byte;
procedure dfs(k:longint);
var j:longint;
begin
viz[k]:=1;
   for j:=1 to a[k,0] do
   if viz[a[k,j]]=0 then
     dfs(a[k,j]);
     nr:=nr+1;
     post[nr]:=k;
end;
procedure dfs2(k:longint);
var j:longint;
begin
viz1[k]:=1; a2:=a2+1;
setlength(a[c],a2+1);
a[c,a2]:=k;
   for j:=1 to t[k,0] do
      if viz1[t[k,j]]=0 then
          dfs2(t[k,j]);

end;
begin
assign(f,'ctc.in'); reset(f);
assign(g,'ctc.out'); rewrite(g);
settextbuf(f,bufin);
settextbuf(g,bufout);
readln(f,n,m);
setlength(a,n+1,1);
setlength(t,n+1,1);
for i:=1 to m do
   begin
   readln(f,x,y);
   setlength(a[x],length(a[x])+1);
   a[x,0]:=a[x,0]+1;
   a[x,a[x,0]]:=y;
   setlength(t[y],length(t[y])+1);
   t[y,0]:=t[y,0]+1;
   t[y,t[y,0]]:=x;
   end;
   setlength(viz,n+1);
   setlength(viz1,n+1);
   setlength(post,n+1);
   for i:=1 to n do
      if viz[i]=0 then
         dfs(i);
   for i:=nr downto 1 do
      begin
          if viz1[post[i]]=0 then
          begin
          c:=c+1;
          a2:=0;
             dfs2(post[i]);
          a[c,0]:=a2;
          end;
      end;
      writeln(g,c);
      for i:=1 to c do
      begin
         for j:=1 to a[i,0] do
             write(g,a[i,j],' ');
        writeln(g);
      end;
close(f);
close(g);
end.