Cod sursa(job #699748)

Utilizator mada0222Tomus Madalina mada0222 Data 29 februarie 2012 21:07:35
Problema Componente tare conexe Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.43 kb
program sss;
var f,g:text;
    n,i,m,x,y,nr,c,nr2,cr: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]:=i;
     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
      if viz[i]=0 then
      begin
        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.