Cod sursa(job #743939)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 6 mai 2012 20:43:50
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.81 kb
Program ctc;
 type lista=^celula;
      celula=record
             next:lista;
             inf:longint;
             end;
 var a,b,c:array [1..100000] of lista;
     aux:array [1..100000] of boolean;
     st:array [1..100000] of longint;
     i,x,y,n,m,nr,st1:longint;
     p:lista;
     fi,fo:text;
procedure dfs(i:longint);
var r:lista;
 begin
  aux[i]:=true; inc(st1); st[st1]:=i; r:=a[i];
   while r<>nil do begin
          if aux[r^.inf]=false then dfs(r^.inf);
            r:=r^.next;
              end;
end;
procedure dfs1(i:longint);
 var r:lista;
begin
 aux[i]:=false; r:=a[i];
  while r<>nil do begin
   if aux[r^.inf]=true then begin
                            new(p); p^.inf:=r^.inf; p^.next:=c[nr]; c[nr]:=p;
                            dfs1(r^.inf);
                            end;
                  r:=r^.next;
                   end;
 end;
begin
 assign(fi,'ctc.in');
  assign(fo,'ctc.out');
 reset(fi); rewrite(fo); readln(fi,n,m);
  for i:=1 to m do begin
                    readln(fi,x,y);
                     new(p); p^.inf:=y; p^.next:=a[x]; a[x]:=p;
                      new(p); p^.inf:=x; p^.next:=b[y]; b[y]:=p;
                    end;
 for i:=1 to n do
  if aux[i]=false then dfs(i);
 for i:=n downto 1 do
  if aux[st[i]]=true then begin
                           inc(nr);
                           new(p); p^.inf:=st[i]; p^.next:=nil; c[nr]:=p;
                           dfs1(i);
                          end;
  writeln(fo,nr);
 for i:=1 to nr do begin
                     p:=c[i];
                     while p<>nil do begin
                                       write(fo,p^.inf,' ');
                                        p:=p^.next;
                                       end;
                     writeln(fo);
                    end;
  close(fo);
end.