Cod sursa(job #1170727)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 14 aprilie 2014 13:28:03
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.08 kb
program Componente_Tare_Conexe;
  type lista=^celula;
                celula=record
                        info:longint;
                        pred:lista;
                        end;
      graf=array[0..100000] of lista;
      stiva=array[0..100000] of longint;

  var g,gr:graf;
      t,v:stiva;
      n,m,i,j,x,y,size_t,size_v,ans:longint;
      r:lista;
      viz:array[0..100000]of 0..1;
      c:array[1..100000] of lista;
  procedure dfs1(nod:longint);
   var r:lista;
   begin
    r:=g[nod];
    viz[nod]:=1;
    while r<>nil do
     begin
      if viz[R^.info]=0 then dfs1(r^.info);
      r:=r^.pred;
     end;
    inc(size_v);
    v[size_v]:=nod;
   end;

  procedure dfs2(nod:longint);
   var r:lista;
   begin
    inc(size_t);
    t[size_t]:=nod;
    r:=gr[nod];
    viz[nod]:=1;
    while r<>nil do
     begin
      if viz[r^.info]=0 then dfs2(r^.info);
      r:=r^.pred;
     end;
   end;

   begin
    assign(input,'ctc.in');
    assign(output,'ctc.out');
    reset(input);
    rewrite(output);
    readln(n,m);
    for i:=1 to m do
     begin
      readln(x,y);
      new(r);
      r^.info:=y;
      r^.pred:=g[x];
      g[x]:=r;
      new(r);
      r^.info:=x;
      r^.pred:=gr[y];
      gr[y]:=r;
     end;
   for i:=1 to n do
     if viz[i]=0 then dfs1(i);
   for i:=1 to n do viz[i]:=0;
   ans:=0;
   for i:=n downto 1  do
     if viz[v[i]]=0 then begin
                size_t:=0;
                dfs2(v[i]);
                inc(ans);
                for j:=1 to size_t do begin
                                        new(r);
                                        r^.info:=t[j];
                                        r^.pred:=c[ans];
                                        c[ans]:=r;
                                        end;

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

   close(output);
  end.