Pagini recente » Cod sursa (job #125271) | Cod sursa (job #2233165) | Cod sursa (job #677507) | Cod sursa (job #1976812) | Cod sursa (job #553686)
Cod sursa(job #553686)
uses crt;
type
kl=array[1..5000,1..5000] of byte;
op=array[1..5000] of byte;
var
i,i2,m,n,a,b,c,d,i3:integer;
f,g:text;
x,x1:kl;
j,j1,j2:op;
procedure lep1(a:integer);
var i:integer;
begin
j[a]:=1;
for i:=1 to n do
if (x[a,i]<>0)and(j[i]<>1) then lep1 (i);
end;
procedure lep2(a:integer);
var i:integer;
begin
if j[a]=1 then j[a]:=3
else j[a]:=2;
for i:=1 to n do
if (x[i,a]<>0)and(j[i]<2) then lep2(i);
end;
procedure keres(a:integer);
var i:integer;
begin
x1[d,c]:=a;
for i:=1 to n do
if (x[a,i]<>0)and(j[i]=3)and(j1[i]=0)
then begin inc(c);x[a,i]:=0;j1[i]:=1; keres(i);end
end;
begin
assign(f,'ctc.in');
reset(f);
assign(g,'ctc.out');
rewrite(g);
readln(f,n,m);
for i:=1 to m do
begin
readln(f,a,b);
x[a,b]:=1;
end;
for i:=1 to n do
if j1[i]=0
then
begin
j1[i]:=1;
lep1(i);
lep2(i);
c:=1; inc(d);
keres(i);
for i3:=1 to c do
for i2:=1 to n do
x[i2,x1[d,i3]]:=0;
j:=j2;
end;
writeln(g,d);
for i:=1 to d do
begin
i2:=1;
while x1[i,i2]<>0 do
begin write(g,x1[i,i2],' ');inc(i2); end;
writeln(g);
end;
close(g);
close(f);
end.