Cod sursa(job #962808)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 15 iunie 2013 18:54:26
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.84 kb
program componente_tare_conexe;
  type lista=^celula;
       celula=record
                info:longint;
                next:lista;
              end;
  var n,m,t,i,x,y:longint;
      a,atrans,comps:array [1..100000] of lista;
      tin,tout:array [1..100000] of longint;
      toutnodes:array [1..200000] of longint;
      processed:array [1..100000] of byte;
      q,r:lista;
      nc:longint;
      bufin,bufout:array[1..100000] of byte;

procedure dfs(x:longint);
  var q:lista;
  begin
    inc(t);
    tin[x]:=t;
    q:=a[x];
    while q<>nil do
      begin
        if tin[q^.info]=0 then dfs(q^.info);
        q:=q^.next;
      end;
    inc(t);
    tout[x]:=t;
    toutnodes[t]:=x;
  end;

procedure dfs2(x:longint);
  var q:lista;
  begin
    processed[x]:=1;
    new(q);
    q^.info:=x;
    q^.next:=comps[nc];
    comps[nc]:=q;
    q:=atrans[x];
    while q<>nil do
      begin
        if processed[q^.info]=0 then dfs2(q^.info);
        q:=q^.next;
      end;
  end;

begin
  assign(input,'ctc.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'ctc.out');
  rewrite(output);
  settextbuf(output,bufout);

  readln(n,m);
  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:=atrans[y];
      atrans[y]:=r;
    end;

  for i:=1 to n do
    if tin[i]=0 then dfs(i);

  for i:=2*n downto 1 do
    begin
      if toutnodes[i]<>0 then
        if processed[toutnodes[i]]=0 then
          begin
            inc(nc);
            dfs2(toutnodes[i]);
          end;
    end;

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

end.