记录编号 |
42188 |
评测结果 |
AAAAAAAA |
题目名称 |
[ZSTU 2579] 著名医生的药方 |
最终得分 |
100 |
用户昵称 |
cqw |
是否通过 |
通过 |
代码语言 |
Pascal |
运行时间 |
0.432 s |
提交时间 |
2012-09-16 23:10:18 |
内存使用 |
1.79 MiB |
显示代码纯文本
program doctor_prescription;
const
ifn='doctor.in';
ofn='doctor.out';
const
maxn=500;
type
suctype=array[0..maxn] of integer;
limit2type=array[1..maxn] of boolean;
var
n,p:longint;
total:longint;
suc:array[0..maxn] of ^suctype;
obj:array[1..maxn] of integer;
dt:array[0..maxn] of integer;
used:array[1..maxn] of boolean;
limit1:array[1..maxn] of integer;
limit2:array[1..maxn] of ^limit2type;
fail:boolean;
procedure read_data;
var
i,k:longint;
begin
assign(input,ifn);
reset(input);
readln(n);
new(suc[0]);
suc[0]^[0]:=n;
for i:=1 to n do suc[0]^[i]:=i;
for i:=1 to n do begin
new(suc[i]);
k:=0;
repeat
inc(k);
read(suc[i]^[k]);
until eoln;
readln;
suc[i]^[0]:=k;
end;
readln(p);
for i:=1 to p do readln(obj[i]);
close(input);
end;
function is_succ(x,y:longint):boolean;
var
i:longint;
begin
is_succ:=true;
for i:=1 to suc[x]^[0] do
if suc[x]^[i]=y then exit;
is_succ:=false;
end;
function is_one_pred(x:longint):longint;
var
i,k:longint;
begin
is_one_pred:=0;
k:=0;
for i:=1 to n do
if is_succ(i,x) then
if k=0 then k:=i
else exit;
is_one_pred:=k;
end;
procedure initialize;
var
i,j,k:longint;
begin
total:=0;
dt[0]:=0;
fail:=true;
for i:=2 to p-1 do
if obj[i]<>0 then begin
k:=is_one_pred(obj[i]);
if k=0 then continue;
for j:=i+1 to p do
if is_succ(k,obj[j]) then exit;
end;
fillchar(used,sizeof(used),true);
for i:=1 to p do
if obj[i]<>0 then used[obj[i]]:=false;
fillchar(limit1,sizeof(limit1),0);
new(limit2[p]);
fillchar(limit2[p]^,sizeof(limit2[p]^),true);
for i:=p-1 downto 1 do begin
if (obj[i+1]<>0) and (obj[i]<>0) then
if not is_succ(obj[i],obj[i+1]) then exit;
new(limit2[i]);
limit2[i]^:=limit2[i+1]^;
if i+2>p then continue;
if obj[i+2]<>0 then begin
for j:=1 to n do
if limit2[i]^[j] then
if is_succ(j,obj[i+2]) then
limit2[i]^[j]:=false;
end;
if obj[i]<>0 then
if not limit2[i]^[obj[i]] then exit;
end;
fail:=false;
end;
procedure save;
begin
inc(total);
end;
procedure print;
var
i:longint;
begin
for i:=1 to p do write(dt[i],' ');
writeln;
end;
procedure limit_inc(x:longint);
var
i:longint;
begin
for i:=1 to suc[x]^[0] do
inc(limit1[suc[x]^[i]]);
end;
procedure limit_dec(x:longint);
var
i:longint;
begin
for i:=1 to suc[x]^[0] do
dec(limit1[suc[x]^[i]]);
end;
procedure try1(z:longint);
var
i,k:longint;
begin
if z>p then begin save; exit; end;
if obj[z]<>0 then begin
if z>1 then
if obj[z-1]=0 then
if not is_succ(dt[z-1],obj[z]) then exit;
if z>1 then limit_inc(dt[z-1]);
dt[z]:=obj[z];
try1(z+1);
if z>1 then limit_dec(dt[z-1]);
end
else begin
for i:=1 to suc[dt[z-1]]^[0] do begin
k:=suc[dt[z-1]]^[i];
if (used[k]) and (limit2[z]^[k]) and (limit1[k]=0) then begin
if z>1 then limit_inc(dt[z-1]);
dt[z]:=k;
used[k]:=false;
try1(z+1);
used[k]:=true;
if z>1 then limit_dec(dt[z-1]);
end;
end;
end;
end;
procedure try2(z:longint);
var
i,k:longint;
begin
if z>p then begin print; exit; end;
if obj[z]<>0 then begin
if z>1 then
if obj[z-1]=0 then
if not is_succ(dt[z-1],obj[z]) then exit;
if z>1 then limit_inc(dt[z-1]);
dt[z]:=obj[z];
try2(z+1);
if z>1 then limit_dec(dt[z-1]);
end
else begin
for i:=1 to suc[dt[z-1]]^[0] do begin
k:=suc[dt[z-1]]^[i];
if (used[k]) and (limit2[z]^[k]) and (limit1[k]=0) then begin
if z>1 then limit_inc(dt[z-1]);
dt[z]:=k;
used[k]:=false;
try2(z+1);
used[k]:=true;
if z>1 then limit_dec(dt[z-1]);
end;
end;
end;
end;
begin
read_data;
initialize;
assign(output,ofn);
rewrite(output);
if fail then writeln('0')
else begin
try1(1);
writeln(total);
try2(1);
end;
close(output);
end.