Cod sursa(job #1169534)

Utilizator vasica38Vasile Catana vasica38 Data 11 aprilie 2014 16:50:48
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.33 kb
program p1;
type lista=^celula;
 celula=record
 info:longint;
 next:lista;
        end;
type tablou=array[0..100000] of lista;
var  a,b,c:tablou;
     f,g:text;
     b1,b2:array[0..1 shl 17 ] of char;
     st:array[0..100000] of longint;
     viz:array[0..100000] of 0..1;
     u,i,x,y,n,m,k,nr:longint;
     v,p:lista;
procedure add(x:longint; var p:lista);
var r:lista;
begin
 new(R);
 r^.info:=x;
 r^.next:=p;
 p:=r;
end;

procedure dfs1(nod:longint);
var r:lista;
begin
 r:=a[nod];
 viz[nod]:=1;

 while r<> nil do begin
        if viz[r^.info]=0 then dfs1(r^.info);
        r:=r^.next;
                end;
 inc(U);
 st[u]:=nod;
end;

procedure dfs2(nod:longint);
var r:lista;
begin
{ write(g,nod,' '); }
 r:=b[nod];
 viz[nod]:=0;
 while r<> nil do begin
        if viz[r^.info]=1 then  begin
                                dfs2(r^.info);
                                new(V);
                                v^.info:=r^.info;
                                v^.next:=c[nr];
                                c[nr]:=v;
                                end;
        r:=r^.next;
                end;
end;


begin
assign(f,'ctc.in');reset(F);
assign(g,'ctc.out');rewrite(G);
settextbuf(f,b1);
settextbuf(g,b2);
readln(f,n,m);
for i:=1 to m do begin
               readln(f,x,y);
               add(y,a[x]);
               add(x,b[y]);
                end;
        for i:=1 to n do
                if viz[i]=0 then begin
                                dfs1(i);
                                 end;

{for i:=1 to n do begin
            v:=b[i];write(g,i,':');
            while v<> nil do begin
                write(G,v^.info,' ');
                v:=v^.next;
                        end;
            writeln(G); end;}



for i:=n downto 1 do
        if viz[st[i]]=1 then begin
                                inc(NR);
                                new(P);
                                p^.info:=st[i];
                                c[nr]:=p;
                                dfs2(st[i]);
                            end;
writeln(G,nr);

for i:=1 to nr do begin
        v:=c[i];
        while v<>nil do begin
                write(g,v^.info,' ');
                v:=v^.next;
                        end;
        writeln(G);
                end;
close(F);
close(G);
end.