Cod sursa(job #714591)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 15 martie 2012 21:11:03
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.14 kb
program ctc;

type pnod=^nod;
     nod=record inf:longint; urm:pnod; end;
     lista=array[1..100000]of pnod;

var fi,fo:Text;
    n,m,i,dimst,nrel,nrcomp:longint;
    l,t,sol:lista;
    bufin,bufout:array[1..1 shl 17]of char;
    viz,viz2:array[1..100000]of 0..1;
    st:Array[1..100000]of longint;
    p:pnod;

    procedure push_back(var l:lista; nod,y:longint);
    var p:pnod;
    begin
        new(p);
        p^.inf:=y;
        p^.urm:=l[nod];
        l[nod]:=p;
    end;

  procedure citire;
  var i,x,y:longint;
  begin
      readln(fi,n,m);
      for i:=1 to n do
        begin
            l[i]:=nil;
            t[i]:=nil;
        end;
      for i:=1 to m do
        begin
            readln(fi,x,y);
            push_back(l,x,y);
            push_back(t,y,x);
        end;
  end;

  procedure dfs(nod:longint);
  var p:pnod;
  begin
      viz[nod]:=1;
      p:=l[nod];
      while p<>nil do
        begin
            if viz[p^.inf]=0 then
              dfs(p^.inf);
            p:=p^.urm;
        end;
      inc(dimst);
      st[dimst]:=nod;
  end;

  procedure dfst(nod:longint);
  var p:pnod;
  begin
      viz2[nod]:=1;
      inc(nrel);
      push_back(sol,nrcomp,nod);

      p:=t[nod];
      while p<>nil do
        begin
            if viz2[p^.inf]=0 then
              dfst(p^.inf);
            p:=p^.urm;
        end;
  end;

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

      citire;

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

      for i:=dimst downto 1 do
        if viz2[st[i]]=0 then
          begin
              inc(nrcomp);
              nrel:=0; //din comp conexa curenta
              dfst(st[i]);
              //cate[nrcomp]:=nrel;
          end;

      writeln(fo,nrcomp);

      for i:=1 to nrcomp do
        begin
            p:=sol[i];
            while p<>nil do
              begin
                  write(fo,p^.inf,' ');
                  p:=p^.urm;
              end;
            writeln(Fo);
        end;

    close(fi); close(fo);
end.