Cod sursa(job #1181228)

Utilizator azkabancont-vechi azkaban Data 2 mai 2014 11:44:17
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.34 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
           viz[nod]:=1;
           r:=lda[nod];
           while r<>nil do begin
                                 if viz[r^.info]=0 then dfs(r^.info);
                                 r:=r^.pred;
                           end;
           new(r);
           r^.info:=nod;
           r^.pred:=stack;
           stack:=r;
    end;

procedure dfs_tr(nod:longint;var v : lista);
    var r:lista;
    begin
           new(r);
           r^.info:=nod;
           r^.pred:=v;
           v:=r;
           viz[nod]:=1;
           r:=lda_tr[nod];
           while r<>nil do begin
                                 if viz[r^.info]=0 then dfs_tr(r^.info,v);
                                 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 dfs(i);
   for i:=1 to n do viz[i]:=0;
   while stack<>nil do begin
                 if viz[stack^.info]=0 then begin
                                                 sol:=sol+1;
                                                 dfs_tr(stack^.info,lsol[sol]);
                                              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.