算法模板——Tarjan强连通分量

功能：输入一个N个点，M条单向边的有向图，求出此图全部的强连通分量

原理：tarjan算法（百度百科传送门），大致思想是时间戳与最近可追溯点

这个玩意不仅仅是求强连通分量那么简单，而且对于一个有环的有向图可以有效的进行缩点（每个强连通分量缩成一个点），构成一个新的拓扑图（如BZOJ上Apio2009的那个ATM）（PS：注意考虑有些图中不能通过任意一个单独的点到达全部节点，所以不要以为直接tarjan(1)就了事了，还要来个for循环，不过实际上复杂度还是O(M)，因为遍历过程中事实上每个边还是只会被走一次^_^）

type
    point=^node;
    node=record
               g:longint;
               next:point;
    end;

var
   i,j,k,l,m,n,h,t,ans:longint;
   ss,s:array[0..100000] of boolean;
   low,dfn,b,f:array[0..100000] of longint;
   a:array[0..100000] of point;
   p:point;
function min(x,y:longint):longint;inline;
         begin
              if x<y then min:=x else min:=y;
         end;
function max(x,y:longint):longint;inline;
         begin
              if x>y then max:=x else max:=y;
         end;
procedure add(x,y:longint);inline;
          var p:point;
          begin
               new(p);
               p^.g:=y;
               p^.next:=a[x];
               a[x]:=p;
          end;
procedure tarjan(x:longint);
          var i,j,k:longint;p:point;
          begin
               inc(h);low[x]:=h;dfn[x]:=h;
               inc(t);f[t]:=x;s[x]:=true;ss[x]:=true;
               p:=a[x];
               while p<>nil do
                     begin
                          if not(s[p^.g]) then
                             begin
                                  tarjan(p^.g);
                                  low[x]:=min(low[x],low[p^.g]);
                             end
                          else if ss[p^.g] then low[x]:=min(low[x],dfn[P^.g]);
                          p:=p^.next;
                     end;
               if low[x]=dfn[x] then
                  begin
                       inc(ans);
                       while f[t+1]<>x do
                             begin
                                  ss[f[t]]:=false;
                                  b[f[t]]:=ans;
                                  dec(t);
                             end;
                  end;
          end;
begin
     readln(n,m);
     for i:=1 to n do a[i]:=nil;
     for i:=1 to m do
         begin
              readln(j,k);
              add(j,k);
         end;
     fillchar(s,sizeof(s),false);
     fillchar(ss,sizeof(ss),false);
     fillchar(f,sizeof(f),0);
     fillchar(low,sizeof(low),0);
     fillchar(dfn,sizeof(dfn),0);
     fillchar(b,sizeof(b),0);
     for i:=1 to n do
         if s[i]=false then tarjan(i);
     for i:=1 to n do a[i]:=nil;
     for i:=1 to n do add(b[i],i);
     for i:=1 to ans do
         begin
              p:=a[i];
              write('No. ',i,' :');
              while p<>nil do
                    begin
                         write(' ',p^.g);
                         p:=p^.next;
                    end;
              writeln;
         end;
     readln;
end.