pascal语言编程题 求高手呀 追加 跪求 进来看一看啊 高分悬赏呀

2024-11-30 04:36:20
推荐回答(3个)
回答(1):

这样的题还有 noip2003 侦探推理
其实这种题也没什么好的方法 完全是在考验你的编程功底
这种题目往往有很低的数据范围 这就是告诉你 这种题很简单 只要你敢去写
简单的枚举而已 为了写的简单加些优化

假设一共有N个人说的是假话 那么我们就枚举N个人 假设他们说的是假话 然后判断你认为说真话的人是否与假设冲突 难的主要是表示状态
附上侦探推理的题目和标称

【问题描述】
明明同学最近迷上了侦探漫画《柯南》并沉醉于推理游戏之中,于是他召集了一群同学玩推理游戏。游戏的内容是这样的,明明的同学们先商量好由其中的一个人充当罪犯(在明明不知情的情况下),明明的任务就是找出这个罪犯。接着,明明逐个询问每一个同学,被询问者可能会说:

证词中出现的其他话,都不列入逻辑推理的内容。
明明所知道的是,他的同学中有N个人始终说假话,其余的人始终说真。
现在,明明需要你帮助他从他同学的话中推断出谁是真正的凶手,请记住,凶手只有一个!
【输入格式】
输入由若干行组成,第一行有二个整数,M(1≤M≤20)、N(1≤N≤M)和P(1≤P≤100);
M是参加游戏的明明的同学数,N是其中始终说谎的人数,P是证言的总数。接下来M行,
每行是明明的一个同学的名字(英文字母组成,没有主格,全部大写)。
往后有P行,每行开始是某个同学的名宇,紧跟着一个冒号和一个空格,后面是一句证词,符合前表中所列格式。证词每行不会超过250个字符。
输入中不会出现连续的两个空格,而且每行开头和结尾也没有空格。
【输出格式】
如果你的程序能确定谁是罪犯,则输出他的名字;如果程序判断出不止一个人可能是
罪犯,则输出 Cannot Determine;如果程序判断出没有人可能成为罪犯,则输出 Impossible。
【输入样例】
3 1 5
MIKE
CHARLES
KATE
MIKE: I am guilty.
MIKE: Today is Sunday.
CHARLES: MIKE is guilty.
KATE: I am guilty.
KATE: How are you??
【输出样例】
MIKE

program logic;
const s1 = 'I am guilty.';
s2 = 'I am not guilty.';
s3 = 'is guilty.';
s4 = 'is not guilty.';
s5 = 'Today is';
var fr,fn,ch : array[1..100] of longint;
nam : array[1..30] of string;
i,j,n,m,k,ans,tot : longint;
flag,done : boolean;
function l(ss:string):longint;
begin
exit(length(ss));
end;
function find_n(ss:string):longint; //判断第几个人
var i : longint;
begin
for i := 1 to n do
if ss = nam[i] then exit(i);
exit(0);
end;
function find_d(ss:string):longint; //判断星期几
begin
if ss = 'Monday.' then exit(1);
if ss = 'Tuesday.' then exit(2);
if ss = 'Wednesday.' then exit(3);
if ss = 'Thursday.' then exit(4);
if ss = 'Friday.' then exit(5);
if ss = 'Saturday.' then exit(6);
if ss = 'Sunday.' then exit(7);
exit(0);
end;
procedure init; //初始化
var i,t,na,rank,f1 : longint;
ss : string;
begin
readln(n,m,k);
for i := 1 to n do
readln(nam[i]);
tot := 0;
for i := 1 to k do {对于每句话,判断是否有用}
begin
readln(ss);
t := pos(':',ss);
na := find_n(copy(ss,1,t-1));
if na = 0 then continue;
delete(ss,1,t+1);
f1 := 0;
if ss = s1 then begin f1 := na; rank := 1; end else {s1 - s5 可见上面的const}
if ss = s2 then begin f1 := na; rank := 2; end else
if (l(s3) begin f1 := find_n(copy(ss,1,l(ss)-l(s3)-1)); rank := 1; end else
if (l(s4) begin f1 := find_n(copy(ss,1,l(ss)-l(s4)-1)); rank := 2; end else
if (l(s5) begin f1 := find_d(copy(ss,l(s5)+2,l(ss)-l(s5)-1)); rank := 3; end;
if f1 = 0 then continue; // rank = 1 表示这个人是罪犯, rank = 2 表示这个人不是罪犯 , rank = 3 表示这是第几天, f1 = 0 表示这句话没有用.
inc(tot);
fr[tot] := na; fn[tot] := f1; ch[tot] := rank; //存下来fr=from fn存提及的人.
end;
end;
procedure work(crime,day:longint); //对于当前枚举的罪犯和天进行判断所有人说的话.
var num,i,f,t : longint;
p : array[0..20] of longint;
begin
fillchar(p,sizeof(p),0);
num := 0;
for i := 1 to k do
begin
case ch[i] of //t=1表示说的真话 t=-1则是假话
1 : if fn[i] = crime then t := 1 else t := -1;
2 : if fn[i] = crime then t := -1 else t := 1;
3 : if fn[i] = day then t := 1 else t := -1;
end;
f := fr[i];
if p[f] = 0 then // 若以前没判断过
begin
p[f] := t;
if t = -1 then inc(num);
end else
if p[f] <> t then exit;
if num > m then exit; //说谎人数过多
end;
for i := 1 to n do //说谎人不足的话可能有说谎人说的无关紧要的话,,加上去
if p[i] = 0 then inc(num);
if num < m then exit; //若仍不足则不满足
if done then //曾经求出解.
begin
writeln('Cannot Determine');
close(output); halt;
end;
flag := true; done := true; ans := crime;
end;
begin
assign(input,'logic.in'); reset(input);
assign(output,'logic.out'); rewrite(output);
init;
ans := 0;
for i := 1 to n do
begin
flag := false;
for j := 1 to 7 do
begin
work(i,j);
if flag then break;
end;
end;
if ans = 0 then writeln('Impossible') //判断是否有解.
else writeln(nam[ans]);
close(output);
end.

关于第二题 这个... 题目描述真的是这样的么 可不可以把全部题目发出来 汉字输入怎么读入......
还有 a说a吃了 B也说A吃了 只有1个人说谎 就是说AB都不可能说谎 也就是说C说谎了 C说的是他跟B都没吃 这句谎言应该怎么理解呢 要理解成“我跟B都吃了” 还是“我吃了 B没吃” 题目描述不怎么清楚啊

回答(2):

答案不唯一,abc/ab/ac都是答案
var
i1,i2,i3,j:longint;
begin
for i1:=1 to 2 do
for i2:=1 to 2 do
for i3:=1 to 2 do
if ord(i1=1)+ord(i1=1)+ord((i3=2) and (i2=2))=2 then begin
if i1=1 then write('a ');
if i2=1 then write('b ');
if i3=1 then write('c ');
writeln;
end;
end.

原理:枚举每个人吃或没吃的情况,1是吃了,b是没吃,之后,因为ord(true)=1 ord(false)=0,判断出说真话的有两人,之后输出即可。

楼主!手打的!!!!!

回答(3):

var
i1,i2,i3,j:longint;
begin
for i1:=1 to 2 do
for i2:=1 to 2 do
for i3:=1 to 2 do
if ord(i1=1)+ord(i1=1)+ord((i3=2) and (i2=2))=2 then begin
if i1=1 then write('a ');
if i2=1 then write('b ');
if i3=1 then write('c ');
writeln;
end;
end.