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

 1 type
 2     point=^node;
 3     node=record
 4                g:longint;
 5                next:point;
 6     end;
 7 
 8 var
 9    i,j,k,l,m,n,h,t,ans:longint;
10    ss,s:array[0..100000] of boolean;
11    low,dfn,b,f:array[0..100000] of longint;
12    a:array[0..100000] of point;
13    p:point;
14 function min(x,y:longint):longint;inline;
15          begin
16               if x<y then min:=x else min:=y;
17          end;
18 function max(x,y:longint):longint;inline;
19          begin
20               if x>y then max:=x else max:=y;
21          end;
22 procedure add(x,y:longint);inline;
23           var p:point;
24           begin
25                new(p);
26                p^.g:=y;
27                p^.next:=a[x];
28                a[x]:=p;
29           end;
30 procedure tarjan(x:longint);
31           var i,j,k:longint;p:point;
32           begin
33                inc(h);low[x]:=h;dfn[x]:=h;
34                inc(t);f[t]:=x;s[x]:=true;ss[x]:=true;
35                p:=a[x];
36                while p<>nil do
37                      begin
38                           if not(s[p^.g]) then
39                              begin
40                                   tarjan(p^.g);
41                                   low[x]:=min(low[x],low[p^.g]);
42                              end
43                           else if ss[p^.g] then low[x]:=min(low[x],dfn[P^.g]);
44                           p:=p^.next;
45                      end;
46                if low[x]=dfn[x] then
47                   begin
48                        inc(ans);
49                        while f[t+1]<>x do
50                              begin
51                                   ss[f[t]]:=false;
52                                   b[f[t]]:=ans;
53                                   dec(t);
54                              end;
55                   end;
56           end;
57 begin
58      readln(n,m);
59      for i:=1 to n do a[i]:=nil;
60      for i:=1 to m do
61          begin
62               readln(j,k);
63               add(j,k);
64          end;
65      fillchar(s,sizeof(s),false);
66      fillchar(ss,sizeof(ss),false);
67      fillchar(f,sizeof(f),0);
68      fillchar(low,sizeof(low),0);
69      fillchar(dfn,sizeof(dfn),0);
70      fillchar(b,sizeof(b),0);
71      for i:=1 to n do
72          if s[i]=false then tarjan(i);
73      for i:=1 to n do a[i]:=nil;
74      for i:=1 to n do add(b[i],i);
75      for i:=1 to ans do
76          begin
77               p:=a[i];
78               write('No. ',i,' :');
79               while p<>nil do
80                     begin
81                          write(' ',p^.g);
82                          p:=p^.next;
83                     end;
84               writeln;
85          end;
86      readln;
87 end.
88