Cod sursa(job #408771)

Utilizator saodem74hieu tran saodem74 Data 3 martie 2010 10:58:13
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.1 kb
uses math;
const
  tfi = 'ctc.in';
  tfo = 'ctc.out';
  maxn  = 100001;
var
  fi,fo : text;
  n,m,top,dem,kq,s : longint;
  h,sta,num,low,f : array[0..maxn] of longint;
  ds  : array[1..2,0..maxn*5] of longint;
  ke  : array[0..10*maxn] of longint;
  free  : array[0..maxn] of boolean;
{-----}
procedure nhap;
var
  i,u,v : longint;
begin
  assign(fi,tfi); reset(fi);
  read(fi,n,m);
  for i := 1 to m do
    begin
      read(fi,u,v);
      ds[1][i] := u; ds[2][i] := v;
      inc(h[u]);
    end;
  close(fi);
end;
{-----}
procedure ktao;
var
  i,u,v : longint;
begin
  for i := 1 to n + 1 do h[i] := h[i-1] + h[i];
  for i := 1 to m do
    begin
      u := ds[1][i]; v := ds[2][i];
      ke[h[u]] := v;
      dec(h[u]);
    end;

  fillchar(free,sizeof(free),true);
  kq := 0;
  top := 0;
  dem := 0;
  s := 0;
end;
{-----}
procedure Push(u : longint);
begin
  inc(top);
  sta[top] := u;
end;
{-----}
function pop : longint;
begin
  pop := sta[top];
  dec(top);
end;
{-----}
procedure DFS(u : longint);
var
  i,v : longint;
begin
  inc(dem); num[u] := dem;
  low[u] := num[u];
  Push(u);
  for i := h[u] + 1 to h[u+1] do
    begin
      v := ke[i];
      if free[v] then
        if num[v] <> 0 then low[u] := min(low[u],num[v])
        else
          begin
            DFS(v);
            low[u] := min(low[u],low[v]);
          end;
    end;
  if num[u] = low[u] then
    begin
      inc(kq);
      repeat
        v := pop;
        inc(s);
        f[s] := v;
        free[v] := false;
      until v = u;
      inc(s);
      f[s] := 0;
    end;
end;
{-----}
procedure xuly;
var
  i : longint;
begin
  for i := 1 to n do
    if num[i] = 0 then DFS(i);
end;
{-----}
procedure inkq;
var
  u,i : longint;
begin
  assign(fo,tfo); rewrite(fo);
  writeln(fo,kq);
  i := 0;
  while kq > 0 do
    begin
      inc(i);
      u := f[i];
      if u = 0 then
        begin
          writeln(fo);
          dec(kq);
        end
      else write(fo,u,' ');
    end;
  close(fo);
end;
{-----}
BEGIN
  nhap;
  ktao;
  xuly;
  inkq;
END.