Cod sursa(job #1422922)

Utilizator ButnaruButnaru George Butnaru Data 20 aprilie 2015 11:48:13
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.25 kb
program ctc;
type
lista=^date;
date=record
m:longint;
next:lista;
end;
type vector1=array[0..100001] of lista;
     vector2=array[0..100001] of longint;
var t,tt,sol:vector1; fr,stiva:vector2;    {t-graful initial,tt-graful transpus,sol-componentele tare conexe}
    n,m,i,j,k,x,y,nr:longint; a:lista;
    f1,f2:text;
procedure dfs(x:longint);
var a:lista;
begin
a:=t[x]; fr[x]:=1;
while a<>nil do begin
if fr[a^.m]=0 then dfs(a^.m);
a:=a^.next;
end;
k:=k+1; stiva[k]:=x;
end;
procedure dfs1(x,l:longint);
var a:lista;
begin
new(a); a^.m:=x; a^.next:=sol[l]; sol[l]:=a;
a:=tt[x]; fr[x]:=1;
while a<>nil do begin
if fr[a^.m]=0 then dfs1(a^.m,l);
a:=a^.next;
end;
end;
begin
assign (f1,'ctc.in');
assign (f2,'ctc.out');
reset (f1);
rewrite (f2);
readln (f1,n,m);
for i:=1 to m do begin
readln (f1,x,y);
new(a); a^.m:=y; a^.next:=t[x]; t[x]:=a;
new(a); a^.m:=x; a^.next:=tt[y]; tt[y]:=a;
end;
k:=0; nr:=0;
for i:=1 to n do
if fr[i]=0 then dfs(i);
for i:=1 to n do fr[i]:=0;
for i:=k downto 1 do
if fr[stiva[i]]=0 then begin nr:=nr+1; dfs1(stiva[i],nr); end;
writeln (f2,nr);
for i:=1 to nr do begin
while sol[i]<>nil do begin write (f2,sol[i]^.m,' '); sol[i]:=sol[i]^.next; end;
writeln (f2);
end;
close (f1);
close (f2);
end.