Cod sursa(job #1181218)

Utilizator azkabancont-vechi azkaban Data 2 mai 2014 11:05:08
Problema Componente tare conexe Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 2.92 kb
type lista=^celula;
       celula=record
         info:longint;
         pred:lista;
       end;

var lda,lda_tr,ldp,lsol:array[1..100000] of lista;
    stack : lista;
    viz:array[1..100000] of byte;
    a,b,n,m,k,i,sol:longint;
    r,v : lista;

procedure add(v:longint; var p:lista);
   var r:lista;
    begin
         new(r);
         r^.info:=v;
         r^.pred:=p;
         p:=r;
    end;

procedure dfs(nod:longint);
    var r:lista;
    begin
           new(r);
           r^.info:=nod;
           r^.pred:=ldp[k];
           ldp[k]:=r;
           viz[nod]:=1;
           r:=lda[nod];
           while r<>nil do begin
                                 if viz[r^.info]=0 then dfs(r^.info);
                                 r:=r^.pred;
                           end;
    end;

procedure dfs_tr(nod:longint);
    var r:lista;
    begin
           new(r);
           r^.info:=nod;
           r^.pred:=lsol[sol];
           lsol[sol]:=r;
           viz[nod]:=1;
           r:=lda_tr[nod];
           while r<>nil do begin
                                 if viz[r^.info]=0 then dfs_tr(r^.info);
                                 r:=r^.pred;
                           end;
    end;

begin
    assign(input,'ctc.in'); reset(input);
    assign(output,'ctc.out'); rewrite(output);
    readln(n,m);
    for i:=1 to m do begin
                          readln(a,b);
                          add(b,lda[a]);
                          add(a,lda_tr[b]);

                     end;
   for i:=1 to n do
                    if viz[i]=0 then begin
                                          k:=k+1;
                                          dfs(i);
                                      end;

   for i:=1 to n do viz[i]:=0;
   stack:=nil;
   for i:=1 to k do begin
                         v:=ldp[i];
                         while v<>nil do begin
                                            new(r);
                                            r^.info:=v^.info;
                                            r^.pred:=stack;
                                            stack:=r;
                                            v:=v^.pred;
                                         end;
                         end;


while stack<>nil do begin
                 if viz[stack^.info]=0 then begin
                                                 sol:=sol+1;
                                                 dfs_tr(stack^.info);

                                                 end;

           stack:=stack^.pred;
           end;
   writeln(sol);
   for i:=1 to sol do begin
                           r:=lsol[i];
                           while r<>nil do begin
                                 write(r^.info,' ');
                                 r:=r^.pred;
                                 end;
                           writeln;
                           end;
   close(input);
   close(output);
end.