记录编号 42188 评测结果 AAAAAAAA
题目名称 [ZSTU 2579] 著名医生的药方 最终得分 100
用户昵称 Gravatarcqw 是否通过 通过
代码语言 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.