算法模板——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[..] of boolean;
    low,dfn,b,f:array[..] of longint;
    a:array[..] 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+]<>x do
                              begin
                                   ss[f[t]]:=false;
                                   b[f[t]]:=ans;
                                   dec(t);
                              end;
                   end;
           end;
 begin
      readln(n,m);
      for i:= to n do a[i]:=nil;
      for i:= 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),);
      fillchar(low,sizeof(low),);
      fillchar(dfn,sizeof(dfn),);
      fillchar(b,sizeof(b),);
      for i:= to n do
          if s[i]=false then tarjan(i);
      for i:= to n do a[i]:=nil;
      for i:= to n do add(b[i],i);
      for i:= 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.