Cod sursa(job #747794)

Utilizator mada0222Tomus Madalina mada0222 Data 11 mai 2012 21:30:06
Problema Componente tare conexe Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.49 kb
program bafoca;
var f,g:text;
n,i,m,x,y,c,nr2,cr,nr:longint;
a,t:array of array of longint;
viz,viz1:array of 0..1;
post:array of longint;
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 dfst(k:longint);
var j:longint;
   begin
   viz1[k]:=1; nr2:=nr2+1;
   setlength(a[c],nr2+1);
   a[c,nr2]:=k;
     for j:=1 to t[k,0] do
        if viz1[t[k,j]]=0 then
           dfst(t[k,j]);

   end;
begin
assign(f,'ctc.in'); reset(f); assign(g,'ctc.out'); rewrite(g);
  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);
      nr:=0; c:=0;
    for i:=1 to n do
      begin
      if viz[i]=0 then
        dfs(i);
      end;
    for i:=nr downto 1 do
      begin
      if viz1[post[i]]=0 then
        begin
        c:=c+1;nr2:=0;
        dfst(post[i]);
        a[c,0]:=nr2;
        end;
      end;
      writeln(g,c);
        for i:=1 to c do
          begin
            for cr:=1 to a[i,0] do
               write(g,a[i,cr],' ');
            writeln(g);
          end;
    close(f); close(g);
end.