P1039 侦探推理

这。。。字符串，好恶心

var i,j,k:longint;
    s:ansistring;
    m,n,p:longint;
    name:array[0..100]of ansistring;
    yes,no:array[0..1000]of boolean;
    what:array[0..100,0..2]of longint;//0为发出的人，1为行为，2为指向的人
    pd:ansistring;
    ans:ansistring;
    sum:longint;
function pddate(s:ansistring):longint;//今天星期几？
begin
  if s='Monday' then exit(1);
  if s='Tuesday' then exit(2);
  if s='Wednesday' then exit(3);
  if s='Thursday' then exit(4);
  if s='Friday' then exit(5);
  if s='Saturday' then exit(6);
  if s='Sunday' then exit(7);
  exit(0);
end;
function getsomeone(s:ansistring):longint;//哪个人？
var i:longint;
begin
  for i:=1 to m do if name[i]=s then exit(i);
  exit(0);
end;
function getname:ansistring;//输入名字
var ch:char;
    name:ansistring;
begin
  ch:=' ';
  while not (ch in ['A'..'Z','a'..'z']) do read(ch);
  if ch in ['a'..'z'] then exit(ch);
  name:='';
  while ch in ['A'..'Z'] do 
  begin
    name:=name+ch;
    read(ch);
  end;
  exit(name);
end;
function getdate:ansistring;//输入星期
var ch:char;
    date:ansistring;
begin
  date:='';
  read(ch);
  while ch in ['a'..'z'] do
  begin
    date:=date+ch;
    read(ch);
  end;
  exit(date);
end;
procedure getwhat(now:longint;name:ansistring);//输入，这个最恶心了
var ch,ch2:char;
    i,j,k,who:longint;
    pd:ansistring;
    st:ansistring;
    someone:ansistring;
    sometime:ansistring;
begin
  ch:=' ';
  while not(ch in ['A'..'Z','a'..'Z']) do read(ch);
  pd:='';
  read(ch2);
  someone:='No';
  sometime:='No';
  if (ch2 in ['a'..'z',' ']) then 
  begin
  if getsomeone(ch)<>0 then someone:=ch else
  pd:=ch+ch2;
  end
  else
  begin
  st:=getname;
  if (st[1] in ['a'..'z']) and (length(st)=1{名字只有一个字，如A}) then
  begin
    someone:=ch+ch2;
    pd:=st;
  end
  else
  begin
  someone:=ch+ch2+st;
  end;
  end;
  while (not eoln) do
  begin
    read(ch);
    if (ch in ['M','T','W','F','S']) then//可能是星期
    sometime:=ch+getdate else
    pd:=pd+ch;
  end;
  st:='';
  i:=1;
  while pd[i] in [':',' '] do inc(i);
  j:=length(pd);
  while not (pd[j] in ['a'..'z']) do dec(j);
  for k:=i to j do st:=st+pd[k];
  who:=getsomeone(name);
  what[now,1]:=-1;//这句话不符合格式则是-1
  what[now,2]:=-1;
  //依次处理
  if st='I am guilty' then 
  begin
  what[now,1]:=1;
  what[now,2]:=who;
  end;
  if st='I am not guilty' then 
  begin
  what[now,1]:=3;
  what[now,2]:=who;
  end;
  if (st='Today is') and (pddate(sometime)<>0) then
  begin
  what[now,1]:=2;
  what[now,2]:=pddate(sometime);
  end;
  if (st='is guilty') then
  begin
  what[now,1]:=1;
  what[now,2]:=getsomeone(someone);
  end;
  if (st='is not guilty') then
  begin
  what[now,1]:=3;
  what[now,2]:=getsomeone(someone);
  end;
end;
procedure writeans;
begin
  write(ans);
  halt;
end;
procedure find;
var i,j,date,people:longint;
begin
  date:=0;
  people:=0;
  for i:=1 to m do no[i]:=false;
  for i:=1 to p do
  if (yes[what[i,0]]) and (what[i,1]<>-1) then//说真话
  begin
    case what[i,1] of
      1:begin
          if people=0 then 
          begin 
            if no[what[i,2]] then 
            exit;
            inc(sum);
            people:=what[i,2];
          end
          else 
          if people<>what[i,2] then
          exit;
        end;
      2:begin
          if date=0 then 
          date:=what[i,2]
          else 
          if date<>what[i,2] then 
          exit;
        end;
      3:begin
          if people=what[i,2] then exit;
          no[what[i,2]]:=true;
        end;
    end;
  end;
  for i:=1 to p do
  if (not yes[what[i,0]]) and (what[i,1]<>-1) then//假话反过来就是真话
  begin
    case what[i,1] of
      1:begin
          if people=what[i,2] then exit;
          no[what[i,2]]:=true;
        end;
      2:begin
          if date=what[i,2] then exit;
        end;
      3:begin
          if people=0 then 
          begin 
            if no[what[i,2]] then 
            exit;
            inc(sum);
            people:=what[i,2];
          end
          else 
          if people<>what[i,2] then
          exit;
        end;
    end;
  end;
  if people=0 then//可能知道除一个以外所有人都不是不是罪犯，那么那个人一定是罪犯
  begin
    for i:=1 to m do
    if not no[i] then
    begin
      if people=0 then people:=i
      else exit;
    end;
  end;
  if people=0 then exit;
  if ans='Impossible' then//找到解了
  ans:=name[people];
  if ans<>name[people] then//有多个解
  begin
    ans:='Cannot Determine';
    writeans;
  end;
  ans:=name[people];
end;
procedure dfs(now,q:longint);//暴力
var i:longint;
begin
  if q>n then exit;
  if (now=m+1) and (q=n) then
  begin
    find;
    exit;
  end;
  if (now=m+1) then exit;
  if q=n then
  begin
    yes[now]:=true;
    dfs(now+1,q);
    exit;
  end;
  yes[now]:=true;
  dfs(now+1,q);
  yes[now]:=false;
  dfs(now+1,q+1);
end;
begin
  readln(m,n,p);
  for i:=1 to m do
  begin
    readln(name[i]);
  end;
  for i:=1 to p do
  begin
    pd:=getname;
    what[i,0]:=getsomeone(pd);
    getwhat(i,pd);
    readln;
  end;
  sum:=0;
  ans:='Impossible';
  dfs(1,0);
  if (sum=0) and (ans='Impossible') then ans:='Cannot Determine';
  writeans;
end.

这可能是我写过的最长的代码了