Cod sursa(job #751802)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 26 mai 2012 23:05:36
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.31 kb
Program p2;
type lista=^celula;
     celula=record
             info:longint;
             next:lista;
             end;
var bufi,bufa:array[0..1 shl 20] of char;
    i,n,m,x,y,nr,st1 : longint;
    a,b,c:array[1..100000] of lista;
    st:array[1..100000] of longint;
    t:array[1..100000] of boolean;
    p,r:lista;

Procedure dfs(r:lista; k :longint);
begin
    t[k]:=true;
    while r<>nil do begin
                    if t[r^.info]=false then dfs(a[r^.info],r^.info);
                    r:=r^.next;
                    end;
    st1:=st1+1;
    st[st1]:=k;
end;

Procedure dfs2(r:lista; k : longint);
begin
    t[k]:=false;
    while r<> nil do begin
                     if t[r^.info]=true then begin
                                             new(p);
                                             p^.info:=r^.info; p^.next:=c[nr]; c[nr]:=p;
                                             dfs2(b[r^.info],r^.info);
                                             end;
                     r:=r^.next;
                     end;
end;

begin
    assign(input,'ctc.in'); reset(input);
    assign(output,'ctc.out'); rewrite(output);
    settextbuf(input,bufi); settextbuf(output,bufa);
    readln(n,m);

    for i:=1 to n do t[i]:=false;

    for i:=1 to m do begin
                     readln(x,y);
                     new(r);
                     r^.info:=y; r^.next:=a[x]; a[x]:=r;
                     new(r);
                     r^.info:=x; r^.next:=b[y]; b[y]:=r;
                     end;

    for i:=1 to n do if t[i]=false then dfs(a[i],i);

    for i:=n downto 1 do if t[st[i]]=true then begin
                                               nr:=nr+1;
                                               new(r);
                                               r^.info:=st[i]; r^.next:=nil; c[nr]:=r;
                                               dfs2(b[st[i]],st[i]);
                                               end;

    writeln(nr);
    for i:=1 to nr do begin
                      r:=c[i];
                      while r<>nil do begin
                                      write(r^.info, ' ');
                                      r:=r^.next;
                                      end;
                      writeln;
                      end;

    close(input); close(output);
end.