Cod sursa(job #697394)

Utilizator andrei_toaderToader Andrei Sorin andrei_toader Data 29 februarie 2012 08:55:54
Problema Componente tare conexe Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.65 kb
program componente;
var f,g:text;
    a,b:array of array of longint;
    viz,viz1,viz2:array of 0..1;
    n,m,i,x,y,j,c:longint;
    bufin,bufout:array[1..65000] of char;
    sol:array of array of longint;

procedure dfs (i:longint);
var j:longint;
begin
   for j:=1 to a[i,0] do
    if (viz1[a[i,j]]=0) and (viz[a[i,j]]=0) then
    begin
      viz1[a[i,j]]:=1;
      dfs(a[i,j]);
    end;
end;

procedure dfst(i:longint);
var j:longint;
begin
 for j:=1 to b[i,0] do
  if (viz2[b[i,j]]=0) and (viz[b[i,j]]=0) then
  begin
  viz2[b[i,j]]:=1;
  dfst(b[i,j]);
  end;
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); setlength (b,n+1); setlength (viz,n+1); setlength (viz1,n+1);
 setlength (viz2,n+1);
 setlength (sol,n+1);
 for i:=1 to n do
 begin
  setlength (a[i],1);
  setlength (b[i],1);
  setlength (sol[i],1);
 end;
 for i:=1 to m do
 begin
  readln (f,x,y);
  a[x,0]:=a[x,0]+1;
  setlength (a[x],length (a[x])+1);
  a[x,a[x,0]]:=y;
  b[y,0]:=b[y,0]+1;
  setlength (b[y],lengtH (b[y])+1);
  b[y,b[y,0]]:=x;
 end;
 c:=0;
 for i:=1 to n do
 begin
  if viz[i]=0 then
  begin
  c:=c+1;
  viz1[i]:=1;
   dfs(i);
  viz2[i]:=1;
   dfst(i);
  for j:=1 to n do
   if (viz1[j]=1) and (viz2[j]=1) and (viz[j]=0) then
   begin
    sol[c,0]:=sol[c,0]+1;
    setlength (sol[c],length (sol[c])+1);
    sol[c,sol[c,0]]:=j;
    viz[j]:=1;
   end;
  end;
 end;
 writeln (g,c);
 for i:=1 to c do
 begin
  for j:=1 to sol[i,0] do
   write (g,sol[i,j],' ' );
  writeln (G);
 end;
close (F); close (G);
end.