Tarjan Pascal程序

program tarjan;

Var
 a:array[0..1000,0..1000] of boolean;
 stack,dfn,low:array[0..1000] of longint;
 v:array[0..1000] of boolean;
 top,all,i,p,q,n,m:longint;

Procedure fopen;
  begin
  assign(input,'tarjan.in');
  assign(output,'tarjan.out');
  reset(input);
  rewrite(output);
end;

Procedure fclose;
  begin
  close(input);
  close(output);
end;

Function min(a,b:longint):longint;
  begin
  if a<b then exit(a) else exit(b);
end;

Procedure tarjan(P:longint);
var
 i:longint;
  begin
  Writeln('Enter P=',p,' low[p]=dfn[p]=',all+1);
  inc(all);
  low[p]:=all;
  dfn[p]:=all;
  inc(top);
  stack[top]:=p;
  v[p]:=true;
  for i:=1 to n do
    if a[p,i] then
      begin
      if dfn[i]=0 then begin tarjan(i); low[p]:=min(low[p],low[i]);end else if v[i] then 
      low[p]:=min(low[p],low[i]);
    end;
  if low[p]=dfn[p] then
    repeat
    v[stack[top]]:=false;
    writeln(p,':',stack[top]);
    dec(top);
  until stack[top+1]=p;
  writeln('Exit P=',p,' low[p]=',low[p],' dfn[p]=',dfn[p]);
end;
  
  begin
  fopen;
  readln(n,m);
  fillchar(a,sizeof(a),false);
  fillchar(v,sizeof(v),false);
  all:=0;top:=0;
  for i:=1 to m do
    begin
    readln(p,q);
    a[p,q]:=true;
  end;
  for i:=1 to n do
    if dfn[i]=0 then tarjan(i);
  fclose;
end.

 

转载于:https://www.cnblogs.com/htfy/archive/2012/11/10/2764451.html