猜数字问题(宾果游戏)的研究?(100分)

我最近对猜数字问题(宾果游戏),我想证明七次以内一定能够猜出来,现在已经
可以证明八次以内了,谁对这个问题感兴趣,我们可以讨论一下

是什么?不好意思,打扰,想听

Bingo怎么玩?

我对这个游戏也很感兴趣，无论我用什么编程工具，做的第一个程序一定是它
无论如何，八次一定可以猜出来
但更少的次数，不知该如何论证，以后想想

文曲星或者好易通上面都有这个游戏
就是10个数字0~9,选择其中四个数字(不重复)让你猜,每猜一次给你一次提示,比方说
实际那个数是4567,你猜4706,给你个提示是1A2B,1A表示位子和数字都对的个数是一个,
2B表示数对,但位子不对的个数是两个
tomol, 我现在也可以证明8次一定能猜出来,但据说可以少于8次

gz

我觉得证明这个问题的方法可以参考4色问题——它是通过穷举才摆平的。
对这个问题来说，只有5040种可能。你只要找到一种算法，对上面的任何一个情况都能在7次
以内解决就可以了。——我估计高效的算法可以在10ms的量级内解决一个——整个穷举证明过程
可以在分钟级的时间内完成！

大家可以参考： http://www.delphibbs.com/delphibbs/dispq.asp?lid=1019431

我的程序可以证明在8次以内一定能猜出来,但我现在还没法减小的7次
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
NumbersType = array[123..9876] of Integer;
TMainForm = class(TForm)
edtA: TEdit;
edtB: TEdit;
lbaA: TLabel;
lbaB: TLabel;
memShow: TMemo;
btnOK: TButton;
btnStart: TButton;
procedure btnStartClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
Numbers: NumbersType;
RandomArrays: array[0..5200] of Integer;
//TotalNumber: Integer;
temp: Integer;
Feedback: array[1..14] of Integer;
MaxTime: Integer;
public
function CorrectArrays(N: Integer): Boolean;
function CompareTo(Swatch, Model: Integer): Integer;
end;

var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.btnStartClick(Sender: TObject);
var
I, cnt: Integer;
procedure RecurGuess(GuessNo: Integer;Time: Integer;
Remain: Integer;
ThisNumbers: NumbersType;
st: string);
//GuessNo:要猜的数；Time：第几次猜；Remain：猜GuessNo时还剩几个可以考虑
//ThisNumbers: 所有数的情况 -1:开始就去掉的 0:前几次去掉的 1:现在要考虑的
//st:打印栈
var
I, J: Integer;
st_temp: string;
Numbers_temp: NumbersType;
begin
st_temp := st;
//临时记住
Numbers_temp := ThisNumbers;
//临时记住
if Remain = 0 then
//出错了
begin
st := st + '不行';
//memShow.Lines.Add(st);
//ShowMessage(st);
end
else
if Remain = 1 then
//就省一个了
begin
st := st + '就省一个了';
//memShow.Lines.Add(IntToStr(Time - 1) + '_' + st);
if Time - 1 > MaxTime then
begin
MaxTime := Time - 1;
memShow.Lines.Add(IntToStr(MaxTime));
memShow.Lines.Add(IntToStr(Time - 1) + '__' + st);
end;
//memShow.Lines.Add(IntToStr(Time - 1));
// ShowMessage(st);
end
else
begin
//实现递归
for J := 1 to 14do
begin
//恢复
st := st_temp;
ThisNumbers := Numbers_temp;
//检查一遍,设置一堆零
for I := 123 to 9876do
begin
if (ThisNumbers = 1) and (CompareTo(I, GuessNo) <> Feedback[J]) then
ThisNumbers := 0;
end;
//求出还有多少可用数,并将其放到随机生成数组中
cnt := 0;
for I := 123 to 9876do
if ThisNumbers = 1 then
begin
RandomArrays[cnt] := I;
inc(cnt);
end;
st := st + IntToStr(Feedback[J]) + ':' + IntToStr(cnt) + ' ';
RecurGuess(RandomArrays[0], Time + 1, cnt, ThisNumbers, st);
end
end
end;
begin
cnt := 0;
for I := 123 to 9876do
if CorrectArrays(I) then
begin
RandomArrays[cnt] := I;
Numbers := 1;
inc(cnt);
end
else
Numbers := -1;
temp := RandomArrays[0];
memShow.Lines.Add('我猜我猜我猜猜猜：' + IntToStr(temp));
Feedback[1] := 0;
Feedback[2] := 1;
Feedback[3] := 2;
Feedback[4] := 3;
Feedback[5] := 4;
Feedback[6] := 10;
Feedback[7] := 11;
Feedback[8] := 12;
Feedback[9] := 13;
Feedback[10] := 20;
Feedback[11] := 21;
Feedback[12] := 22;
Feedback[13] := 30;
Feedback[14] := 40;
//开始调用递归
MaxTime := 0;
//RecurGuess(temp, 1, 5040, Numbers, '');
ShowMessage('OK');
end;

procedure TMainForm.btnOKClick(Sender: TObject);
var
I, A, B, AB, cnt: Integer;
begin
////////////////////////////////////////////////////////////////////////////////
//先错误检查,对用户输入的两个数字检错 //
//先不做 //
////////////////////////////////////////////////////////////////////////////////
A := StrToInt(edtA.Text);
B := StrToInt(edtB.Text);
if A + B > 4 then
begin
ShowMessage('输入错误!!');
exit;
end;
////////////////////////////////////////////////////////////////////////////////
//对,此结果进行判断,用筛法 //
////////////////////////////////////////////////////////////////////////////////
AB := A * 10 + B;
for I := 123 to 9876do
begin
if (Numbers = 1) and (CompareTo(I, temp) <> AB) then
Numbers := 0;
end;
cnt := 0;
for I := 123 to 9876do
if Numbers = 1 then
begin
RandomArrays[cnt] := I;
inc(cnt);
end;
for I := 0 to cnt - 1do
memShow.Lines.Add(IntToStr(I) + ' ' + IntToStr(RandomArrays));
if cnt = 1 then
ShowMessage('猜到了!!' + IntToStr(RandomArrays[0]))
else
if cnt = 0 then
begin
ShowMessage('错了！！！');
Exit;
end;
temp := RandomArrays[0];
memShow.Lines.Add('我猜我猜我猜猜猜：' + IntToStr(temp));
end;

function TMainForm.CorrectArrays(N: Integer): Boolean;
var
i4, i3, i2, i1: Integer;
begin
i4 := N div 1000 mod 10;
i3 := N div 100 mod 10;
i2 := N div 10 mod 10;
i1 := N mod 10;
if ((i3 = i2) or (i3 = i1) or (i2 = i1)) or
(i4 = i3) or (i4 = i2) or (i4 = i1) then
result := false
else
result := true;
end;

////////////////////////////////////////////////////////////////////////////////
//这个函数就是比较两个数的关系，例如Swatch＝4703 Model＝3764 那么函数的返回值//
//就应该是12，意思就是1A 2B //
////////////////////////////////////////////////////////////////////////////////
function TMainForm.CompareTo(Swatch, Model: Integer): Integer;
var
a4, a3, a2, a1: Integer;
b4, b3, b2, b1: Integer;
begin
a4 := Swatch div 1000 mod 10;
a3 := Swatch div 100 mod 10;
a2 := Swatch div 10 mod 10;
a1 := Swatch mod 10;
b4 := Model div 1000 mod 10;
b3 := Model div 100 mod 10;
b2 := Model div 10 mod 10;
b1 := Model mod 10;
result := 0;
if a1 = b1 then
result := result + 10;
if a2 = b2 then
result := result + 10;
if a3 = b3 then
result := result + 10;
if a4 = b4 then
result := result + 10;
if (a1 = b2) or (a1 = b3) or (a1 = b4) then
inc(result);
if (a2 = b1) or (a2 = b3) or (a2 = b4) then
inc(result);
if (a3 = b1) or (a3 = b2) or (a3 = b4) then
inc(result);
if (a4 = b1) or (a4 = b2) or (a4 = b3) then
inc(result);
end;

end.

请结束或提前您的帖子，谢谢合作！

多人接受答案了。