1506传话

这个算法很简单，但是超时：

var

  n,m,i,x,y:longint;

  f:array[1..1000,1..1000] of boolean;

procedure floyd;

var

  k,i,j:longint;

begin

  for k:=1 to n do

    for i:=1 to n do

      forj:=1 to n do

       f[i,j]:=f[i,j] or (f[i,k] and f[k,j]);

end;

begin

  fillchar(f,sizeof(f),false);

  read(n,m);

  for i:=1 to m do

    begin

     read(x,y);

     f[x,y]:=true;

    end;

  floyd;

  for i:=1 to n do

    if f[i,i] thenwriteln('T')

    else write('F');

end.

简单的深搜仍然超时：

var

  n,m,a,b,i,d:longint;

  f:array[1..1000,1..1000] of boolean;

  used:array[1..1000] of boolean;

  flag:boolean;

procedure search(x:longint;var d:longint);

var

  k:longint;

begin

  if (x=i) and (d>0) and (notflag) then

    begin

     writeln('T');

     flag:=true;

     exit;

    end;

  for k:=1 to n do

    if (f[x,k]) and (notused[k]) then

     begin

       used[k]:=true;

       inc(d);

       search(k,d);

       used[k]:=false;{去掉这一句还是超时，只能8个点，不要回溯}

     end;

end;

begin

  fillchar(f,sizeof(f),false);

  read(n,m);

  for i:=1 to m do

    begin

     read(a,b);

     f[a,b]:=true;

    end;

  for i:=1 to n do

    begin

     fillchar(used,sizeof(used),false);

     flag:=false;

     d:=0;

     search(i,d);

      ifnot flag then writeln('F');

    end;

end.

弱弱地：还是用邻接链表存边吧。。。