Cod sursa(job #410943)

Utilizator jiangweipirlo andrea jiangwei Data 4 martie 2010 17:31:37
Problema Componente tare conexe Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.13 kb
uses math;
const
  tfi = 'ctc.in';
  tfo = 'ctc.out';
  maxn  = 100001;
var
  fi,fo : text;
  n,m,top,dem,kq,s : longint;
  low,num,h,sta : array[0..maxn] of longint;
  ds  : array[0..maxn*2,1..2] of longint;
  ke  : array[0..4*maxn] of longint;
  free  : array[0..maxn] of boolean;
  d : array[0..maxn*2] of longint;
{-----}
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[i][1] := u; ds[i][2] := v;
      inc(h[u]);
    end;
  close(fi);
end;
{-----}
procedure Push(u : longint);
begin
  inc(top);
  sta[top] := u;
end;
{-----}
function pop : longint;
begin
  pop := sta[top];
  dec(top);
end;
{-----}
procedure ktao;
var
  i,u,v : longint;
begin
  top := 0;  dem := 0;
  for i := 1 to n + 1 do h[i] := h[i-1] + h[i];
  for i := 1 to m do
    begin
      u := ds[i][1]; v := ds[i][2];
      ke[h[u]] := v;
      dec(h[u]);
    end;
  fillchar(free,sizeof(free),true);
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 low[u] = num[u] then
    begin
      inc(kq);
      repeat
        v := pop;
        free[v] := false;
        inc(s);
        d[s] := v;
      until v = u;
      inc(s); d[s] := 0;
    end;
end;
{-----}
procedure xuly;
var
  i : longint;
begin
  s := 0;
  fillchar(num,sizeof(num),0);
  for i := 1 to n do
    if num[i] = 0 then dfs(i);
end;
{-----}
procedure inkq;
var
  i : longint;
begin
  assign(fo,tfo); rewrite(fo);
  writeln(fo,kq);
  i := 1;
  while kq > 0 do
    begin
      while d[i] <> 0 do
        begin
          write(fo,d[i],' ');
          inc(i);
        end;
      inc(i); writeln(fo);
      dec(kq);
    end;
  close(fo);
end;
{-----}
BEGIN
  nhap;
  ktao;
  xuly;
  inkq;
END.