显示代码纯文本
var
a,b,c,d,e,m,n,p,ooo:longint;
l:array[0..1000,0..1000]of longint;
hx:array[0..500]of longint;
k,lz,o:array[0..1000]of longint;
procedure dfs1(x:longint);
var
y,z,i,j,u,h,r:longint;
begin
if x=p+1 then
begin
h:=0;
for i:=1 to p do
if i>2 then
for j:=i to p do
for u:=1 to lz[o[i-2]] do
if o[j]=l[o[i-2],u] then
h:=1;
if h=0 then
ooo:=ooo+1;
end
else
begin
for y:=1 to lz[o[x-1]] do
begin
if k[x]<>0 then
if (l[o[x-1],y]=k[x])and(hx[k[x]]=0) then
begin
o[x]:=k[x];
hx[o[x]]:=1;
dfs1(x+1);
hx[o[x]]:=0;
end;
if (k[x]=0)and(hx[l[o[x-1],y]]=0) then
begin
o[x]:=l[o[x-1],y];
hx[o[x]]:=1;
dfs1(x+1);
hx[o[x]]:=0;
end;
end;
end;
end;
procedure dfs2(x:longint);
var
y,z,i,j,u,h,r,q:longint;
begin
if x=p+1 then
begin
h:=0;
for i:=1 to p do
if i>2 then
for j:=i to p do
for u:=1 to lz[o[i-2]] do
if o[j]=l[o[i-2],u] then
h:=1;
if h=0 then
begin
for q:=1 to p-1 do
write(o[q],' ');
write(o[p]);
writeln;
end;
end
else
begin
for y:=1 to lz[o[x-1]] do
begin
if k[x]<>0 then
if (l[o[x-1],y]=k[x])and(hx[k[x]]=0) then
begin
o[x]:=k[x];
hx[o[x]]:=1;
dfs2(x+1);
hx[o[x]]:=0;
end;
if (k[x]=0)and(hx[l[o[x-1],y]]=0) then
begin
o[x]:=l[o[x-1],y];
hx[o[x]]:=1;
dfs2(x+1);
hx[o[x]]:=0;
end;
end;
end;
end;
begin
assign(input,'doctor.in');
assign(output,'doctor.out');
reset(input);
rewrite(output);
readln(n);
for a:=1 to n do
begin
while not eoln do
begin
inc(lz[a]);
read(l[a,lz[a]]);
end;
readln;
end;
readln(p);
for a:=1 to p do
readln(k[a]);
for a:=1 to n do
begin
o[1]:=a;
hx[a]:=1;
dfs1(2);
hx[a]:=0;
end;
writeln(ooo);
fillchar(hx,sizeof(hx),0);
for a:=1 to n do
begin
o[1]:=a;
hx[a]:=1;
dfs2(2);
hx[a]:=0;
end;
close(input);
close(output);
end.
wangmengyuan