这。。。字符串,好恶心
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.
这可能是我写过的最长的代码了