Pagini recente » Cod sursa (job #2101034) | Cod sursa (job #2103637) | Cod sursa (job #678379) | Cod sursa (job #763818) | Cod sursa (job #285901)
Cod sursa(job #285901)
//Arhiva educationala - Componente tare conexe - Tarjan
type
adresa = ^nod;
nod = record inf : longint; adr : adresa; end;
var
n,m,nst,i,x,y, nr,id: longint;
q : adresa;
v, cnx : array [1..100000] of adresa;
idx,low, st: array[1..100000] of longint;
inst : array[1..100000] of byte;
f : text;
function min (x,y: longint) : longint;
begin
if (x <= y) then min := x else min := y;
end;
procedure tarjan (k: longint);
var
q : adresa;
t : longint;
begin
idx [k] := id;
low [k] := id;
id := id + 1;
inc (nst); st[nst] := k; inst[k]:=1;
q := v [k];
while (q <> nil) do
begin
if (idx[q^.inf] = 0) or (inst[q^.inf] = 1) then
begin
if (idx[q^.inf] = 0) then
tarjan(q^.inf);
low[k] := min (low[k], low[q^.inf]);
end;
q := q^.adr;
end;
if (low[k] = idx[k]) then
begin
inc (nr);
repeat
t:= st[nst]; dec(nst); inst[k] := 0;
new(q); q^.inf := t; q^.adr := cnx[nr]; cnx[nr] := q;
until t = k;
end;
end;
begin
assign (f, 'ctc.in');
reset (f);
readln (f, n, m);
for i:=1 to m do
begin
readln (f, x, y);
new (q); q^.inf := y; q^.adr := v[x]; v[x] := q;
end;
close (f);
nst :=0;
id := 1;
for i:=1 to n do
if (idx[i] = 0) then
tarjan (i);
assign (f, 'ctc.out');
rewrite (f);
writeln (f, nr);
for i:=1 to nr do
begin
q := cnx[i];
while (q<> nil) do
begin
write(f,q^.inf, ' ');
q:= q^.adr;
end;
writeln(f);
end;
close (f);
end.