Cod sursa(job #410107)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 4 martie 2010 09:25:55
Problema Componente tare conexe Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.44 kb
const nmax=25000;
 var a,a2:array[1..nmax,0..10000] of 0..1;
     viz1,viz2:array[1..nmax] of longint;
     p,j,l,k,nc,i,s,n,x,y:longint;
     m:longint;
     f,g:text;
     ok:boolean;
 procedure DF(x:longint);
 var i:integer;
begin
  viz1[x]:=p;
  for i:=1 to a[x,0] do
    if (viz1[a[x,i]]=0) then DF(a[x,i]);
end;
procedure DF2(x:longint);
var i:integer;
begin
  viz2[x]:=p;
  for i:=1 to a2[x,0] do
    if (viz2[a2[x,i]]=0) then DF2(a2[x,i]);
end;

begin
  assign(f,'ctc.in');
  reset(f);
  readln(f,n,M);
  for i:=1 to m do
  begin
  readln(f,x,y);
  a[x,0]:=a[x,0]+1;
  a[x,a[x,0]]:=y;
  a2[y,0]:=a2[y,0]+1;
  a2[y,a2[y,0]]:=x;
  end;

  close(f);
  assign(g,'ctc.out');
  nc:=1;
 p:=0;
  x:=1;
  repeat
        ok:=true;
        p:=p+1;
        DF(x);
        DF2(x);
        for i:=1 to n do
            if (viz1[i]<>viz2[i])then
                                  begin
                                       viz1[i]:=0;
                                       viz2[i]:=0;
                                       end;

        for i:=1 to n do
            if viz1[i]=0 then begin
               ok:=False;
               x:=i;
               nc:=nc+1;
               break;
            end;

  until ok;
  rewrite(g);
  writeln(g,nc);
  for i:=1 to nc do
    begin
    p:=i;
    for j:=1 to n do
       if viz1[j]=p then
                  write(g,j,' ');
    writeln(g);
    end;
  close(g);
End.