讨论 / 求助侦探 推理
win0000 2010-10-21 03:27:00
点我顶贴 收藏 删除
那米有错啦、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、

全是不可能。、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、、

const cant:string='Cannot Determine';

im:string='Impossible';

iam:string=': I am guilty.';

inot:string=': I am not guilty.';

sbis:string=' is guilty.';

sbnot:string=' is not guilty.';

day:array [1..7] of string=('Today is Monday.','Today is Tuesday.','Today is Wednesday.','Today is Thursday.','Today is Friday.','Today is Saturday.','Today is Sunday.');

type kk=0..4;

kkk=record

tt:0..5;

s,m:integer;

end;

var per:array [1..20] of string;

p:array [1..100] of string;

yn:array [1..20] of kk;

pp:array [1..100] of kkk;

pern,lien,pn,i,j,a1,a2,a0,t,ans:integer;

pt,ps:string;

procedure fenni(x:string);

begin

with pp[j] do begin

t:=pos(iam,x);

if (t>0) and(t+13=length(x)) then

begin tt:=1;pt:=copy(x,1,t-1);

for i:=1 to pern do if per[i]=pt then begin m:=i; s:=i;exit;end;end;

t:=pos(inot,x);

if (t>0) and (t+18=length(x)) then

begin tt:=2;pt:=copy(x,1,t-1);

for i:=1 to pern do if per[i]=pt then begin m:=i;s:=i;exit;end;end;

t:=pos(sbis,x);

if (t>0) and (t+9=length(x)) then

begin

delete(x,t,length(x)-t+1);

t:=pos(': ',x);

ps:=copy(x,1,t-1);

delete(x,1,t+1);

for i:=1 to pern do

if ps=per[i] then begin m:=i; break; end;

for i:=1 to pern do

if x=per[i] then begin s:=i;tt:=3; exit end;x:=p[j];end;

t:=pos(sbnot,x);

if (t>0) and (t+14=length(x)) then

begin

delete(x,t,length(x)-t+1);

t:=pos(': ',x);

ps:=copy(x,1,t-1);

delete(x,1,t+1);

for i:=1 to pern do

if ps=per[i] then begin m:=i; break; end;

for i:=1 to pern do

if x=per[i] then begin s:=i;tt:=4; exit end;x:=p[j];end;

t:=pos(': ',x);

ps:=copy(x,1,t-1);

for i:=1 to pern do if ps=per[i] then begin m:=i;break;end;

delete(x,1,t+1);

for i:=1 to 7 do

if x=day[i] then begin tt:=5;s:=i;exit;end;

tt:=0;

end; end;

function work(a:integer):integer;

var i,j,k:integer;

begin

for i:=1 to pern do yn[i]:=0;

for k:=1 to 7 do begin

for j:=1 to pn do

begin

if yn[pp[j].m] in [1,2] then continue;

case pp[j].tt of

1,3:if a=pp[j].s then yn[pp[j].m]:=1 else yn[pp[j].m]:=2;

2,4:if a=pp[j].s then yn[pp[j].m]:=2 else yn[pp[j].m]:=1;

5:if a=pp[j].s then yn[pp[j].m]:=3 else yn[pp[j].m]:=4;

end;

end;

for i:=1 to pern do

case yn[i] of

0:inc(a0);

1,3:inc(a1);

2,4:inc(a2);

end;

if (a2<=lien) and (a2+a0>=lien) then

if ans<>0 then begin writeln(cant);halt;end

else exit(i);

end;

work:=0;

end;

begin

readln(pern,lien,pn);

for i:=1 to pern do

readln(per[i]);

for j:=1 to pn do readln(p[j]);

for j:=1 to pn do //fenni

fenni(p[j]);

ans:=0;

for i:=1 to pern do begin ans:=work(i);end;

if ans<>0 then writeln(per[ans]) else writeln(im);

end.

查看更多回复
提交回复