Cod sursa(job #1367357)

Utilizator mariusadamMarius Adam mariusadam Data 1 martie 2015 20:11:21
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.66 kb
program ctce;
var     ctc:array of array of longint;
        g,gt:array[0..1,1..200000] of longint;
        st,sg,sgt:array[1..100000] of longint;
        viz:array[1..100000] of 0..1;
        bufin,bufout:array[1..65535] of byte;
        n,m,i,j,k,sol:longint;
        fi,fo:text;

procedure citire;
var     i,j,k:longint;
begin
 readln(fi,n,m);
 setlength(ctc,n+1,1);
 for k:=1 to m do
 begin
        readln(fi,i,j);
        g[0,k]:=j;
        g[1,k]:=sg[i];
        sg[i]:=k;
        gt[0,k]:=i;
        gt[1,k]:=sgt[j];
        sgt[j]:=k;
 end;
end;

procedure df(nod:longint);
var     p:longint;
begin
 viz[nod]:=1;
 p:=sg[nod];
 while p<>0 do
 begin
        if viz[g[0,p]]=0 then
                df(g[0,p]);
        p:=g[1,p];
 end;
 k:=k+1;
 st[k]:=nod;
end;

procedure dft(nod:longint);
var     p:longint;
begin
 viz[nod]:=1;
 p:=sgt[nod];
 ctc[sol,0]:=ctc[sol,0]+1;
 setlength(ctc[sol],ctc[sol,0]+1);
 ctc[sol,ctc[sol,0]]:=nod;
 while p<>0 do
 begin
        if viz[gt[0,p]]=0 then
                dft(gt[0,p]);
        p:=gt[1,p];
 end;
end;

begin
 assign(fi,'ctc.in'); reset(fi);
 assign(fo,'ctc.out'); rewrite(fo);
 settextbuf(fi,bufin);
 settextbuf(fo,bufout);
 citire;
 k:=0;
 for i:=1 to n do
        if viz[i]=0 then
                df(i);
 sol:=0;
 for i:=1 to n do
        viz[i]:=0;
 for i:=n downto 1 do
        if viz[st[i]]=0 then
        begin
                sol:=sol+1;
                dft(st[i]);
        end;
 writeln(fo,sol);
 for i:=1 to sol do
 begin
        for j:=1 to ctc[i,0] do
                write(fo,ctc[i,j],' ');
        writeln(fo);
 end;
 close(fi);
 close(fo);
end.