Cod sursa(job #285901)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 23 martie 2009 09:38:32
Problema Componente tare conexe Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.65 kb
//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.