type seto=set of 1..210;

ss=array[0..210]of seto;

var i,j,k,n,p,tm,sum:integer;

aa,bb,rr:ss;

procedure find(z:integer);

var i,j,pd:integer;

dd:seto; begin

dd:=[p];

repeat pd:=1; for i:=1 to n do if i in dd then begin for j:=1 to n do if (j in aa[i]) and (not (j in dd)) and (j<>z) then begin dd:=dd+[j]; bb[j]:=bb[j]+[z]; pd:=0; end; end; until pd=1; end; begin readln(n,p); for i:=1 to n do for j:=1 to n do begin read(tm); if tm=1 then aa[i]:=aa[i]+[j];

end; for i:=1 to n do if i<>p then find(i); for i:=1 to n do if i<>p then begin sum:=0; for j:=1 to n do if not(j in bb[i]) and (j<>p) and (j<>i) then begin rr[i]:=rr[i]+[j]; sum:=sum+1; end; if (rr[i]=[]) or (sum=n-2) then writeln('No' ) else begin for j:=1 to n do if j in rr[i] then write(j,' '); writeln; end; end; end. 程序2: var i,j,a,n,p:integer; q:array[1..200,1..200]of boolean; rem:array[1..200,0..200]of integer; lin:array[1..200]of boolean; procedure rune(m:integer); {更短的深搜记录} var x,y,z:integer; begin lin[m]:=false; for x:=1 to n do if (q[m,x]) and (lin[x]) then rune(x); end; begin read(n,p); for i:=1 to n do for j:=1 to n do begin read(a); if a=1 then q[i,j]:=true; end; for i:=1 to n do if i<>p then begin fillchar(lin,sizeof(lin),true); lin[i]:=false; rune(p); for j:=1 to n do if lin[j] then begin {记录可拦截的点} rem[j,0]:=rem[j,0]+1; rem[j,rem[j,0]]:=i; end;