有谁知道“猜数字”游戏的算法？(50分)

猜数字游戏，每个文曲星上都会有的游戏。
我有个这个游戏，可以电脑猜数字，就是电脑猜，你输入几A几B，一般在6到7次就一定能
猜出来！
有谁知道电脑猜的算法？

怎么没有人感兴趣吗！？

猜数字——文曲星的辉煌
文 金鑫
为了响应老猫的号召，本人想起了半年前用delphi5.0 做的一个类似文曲星里猜数字的
小游戏，最近，我又拿出来整理了一下，完善了其功能，令它放出了霸者的傲气，真是同类
游戏的佼佼者（我呕！胡吹牛！）。
哈哈，不好意思，有些自卖自夸，请各位老编小编以及读者见量。
好了，进入正题(突然严肃起来了)，先介绍一下操作，比如：随机四个数是1234，通
过键盘输入你猜的四个数，如果你输入的是1456，memo控件将显示1A1B，因为你猜的1位置
对了，数字也对了，所以是1A；而4只猜对了数字，位置不对，正确的位置是第四位，而你
猜的的是第二位。如果输入7890，memo控件将显示0A0B，因为你猜的的数字位置均不对（靠
，手气真臭），如果你输入1234，就是4A0B，就是全对了。以此类推，如果输入了3478就
是0A2B，输入2143就是0A4B，7235就是2A0B。懂否？实在不懂，就去看看文曲星上的有关
猜数字的说明吧。
现在，开始我们的程序吧。
首先是窗体设计。一个mainmenu控件、memo控件，一个edit和三个label控件。在菜
单编辑器上有三项其caption分别为“新游戏”，“显示答案”，“退出”，name属性为
new，answer，exit。
其次是代码部分。我只罗列了主要算法的代码。
分别声名几个函数和过程：
function checkAandB:string;
function checkrepeat:boolean;
procedure start;
procedure keyinput;
procedure youwin;
procedure randommaker;
声名全局变量.
var
aa:array[1..4] of integer;
adr:array[1..4] of integer;
m,j:integer;
goal:boolean;
procedure randommaker;//该过程产生随机的四个数;
begin
randomize;
begin
aa[1]:=random(10);
aa[2]:=random(10);
while aa[2]=aa[1] do
aa[2]:=random(10);
aa[3]:=random(10);
while (aa[3]=aa[2])or (aa[3]=aa[1]) do
aa[3]:=random(10);
aa[4]:=random(10);
while (aa[4]=aa[1])or (aa[4]=aa[2])or( aa[4]=aa[3]) do
aa[4]:=random(10);
end;
end;
function checkAandB:string;//该过程检验是*A*B;
var A,B:integer;
c,d:integer;
begin
A:=0;
B:=0;
for c:=1 to 4 do
for d:=1 to 4 do
if aa[c]=adr[d]then
if aa[c]=adr[c]then
A:=A+1
else
B:=B+1;
result:=inttostr(A)+'A'+inttostr(B)+'B';
if (aa[1]=adr[1])and(aa[2]=adr[2])and(aa[3]=adr[3])and(aa[4]=adr[4])then
goal:=true;
end;
function checkrepeat:boolean;
begin
if (adr[1]=adr[2])or( adr[1]=adr[3])or (adr[1]=adr[4])or (adr[2]=adr[3])or
(adr[2]=adr[4])or (adr[3]=adr[4]) then
result:=true
else result:=false;
end;
procedure start;
begin
m:=0;
goal:=false;
j:=0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
randommaker;
start;
end;
procedure TForm1.newgame1Click(Sender: TObject);
begin
randommaker;
start;
end;
procedure keyinput;//该过程从edit中获得数据;
var x:integer;
f:string;
begin
f:=form1.Edit1.Text;
for x:=1 to 4 do
adr[x]:=strtoint(copy(f,x,1));
end;
procedure TForm1.Edit1KeyPress(Sender: TObject
var Key: Char);//执行键盘输入操作
;
begin
if key in['0'..'9'] then
begin
if j<4 then//如果输入的位数小于四则继续输入,否则什么也不做;
j:=j+1
else key:=chr(0);
end else
if(j=4) and(key=char(13)) then //如果位数为四,按enter键,执行keyinput过程;
begin
keyinput;
if checkrepeat=true then
begin
showmessage('数字重复,请重新输入!');
end else
begin
if (m<=7)then
begin
m:=m+1;
j:=0;
Memo1.Lines.Add(form1.Edit1.Text+' '+checkAandB);
if goal=true then
youwin;
end else
showmessage('哈哈，已经八次了，还来？没门。重新开始吧！！');
end;
j:=0;
key:=chr(0);
end else
if key=char(8)then //char(8)back space键;
begin
if j>0 then // 执行退位
j:=j-1
end else
key:=chr(0);
end;
procedure youwin;
begin
if messagedlg('very good,天才,是否从来?',mtInformation,[mbOK, mbCancel],0) = mrok then
begin
randommaker;
start;
end;
end;
procedure TForm1.answer1Click(Sender: TObject);
begin
messagedlg('嘿嘿，不会了吧？让我告诉你答案吧！！答案是：'
+inttostr(aa[1])+inttostr(aa[2])+inttostr(aa[3])+inttostr(aa[4]),
mtInformation ,[mbOK, mbCancel],0);
j:=0;
end;
end.
大功告成，操作我不在赘诉，程序本身的关于中有介绍。程序在win98+delphi5.0下
运行通过。
其他的完善的代码大家自己加吧。如果想交朋友，就给我发email：zergling13@263.net。

每一次都是随机猜的,只不过每次根据你的回答将不符合的数删除,
7次后最多只剩一个数

>>每一次都是随机猜的,只不过每次根据你的回答将不符合的数删除
关键就在这里面——它只知道4个数里面有几个是对的，而不知道到底是哪几个。
“随机猜”和“将不符合的数删除”里面有文章喲~

呵呵，老猫也有审题不准的时候。他要的可是解法。

学习～

creation-zy说得对！
我要的不是这个，是解法！是电脑猜，你输入几Ａ几Ｂ。最后电脑把你的数字猜出来！！

我一直想不通为什么电脑一定可以在8次以内猜出来。
有人知道的话贴代码上来。分不够可以再加。

这里是别人写的一个猜数字游戏。可以电脑猜。26k就搞定了，绝对经典！
http://www.yaguo.com/~icank/software/guess.exe

如果程序猜1234，我回答0A0B。那么就可以把所有包括1或2或3或4的数都去掉，
这很难么？

如果不是0A0B呢？
这个游戏存在着一定的运气啊，不是仅仅靠逻辑推理能猜出来的啊。
我想要代码。

如果让电脑来算这个数，不知道各位大虾有什么好的算法，本人愚笨，觉得似乎
只有穷举法，而每一次使用穷举法时是在上一次筛选出来的数字上进行的。

就用穷举排除就可以了。 4位数字的猜数平均 5-6次猜中。
过程如下：
1. 初始化全部的数字组合, 4位数字的排列有5040种
2. 把5040个数字串全部存在字符串数组或者TStringList中
3. 计算机随机猜一个数字，如1234， 人工评价，xAyB
4. 遍历第二步中的数组， 把所有与1234比较的结果等于xAyB的都保留下来，
保存到数组或者TStringList中
5. 计算机再从第四步的数组中，随机选一个数字
.....

重复这个过程， 最后就剩下正确的了。
根据我的经验， 初始化5040个数字， 第一次筛选后，最多剩下1440个， 第二次筛选后，
剩几百个，第三次后剩几十个，第四次后，剩几个， 第五次铁定猜中。 加上最初的那个
数字， 也就是说， 绝对超不过6次。 如果运气好（比如出现0A4B），猜中的次数就会
少。

//我的代码如下： （有点土，高手莫笑，呵呵）
//计算机一开始就会猜一个数字，所以，在运行程序前，先想一个数字，呵呵
//------------------------------------------------

nit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit
//写入位置正确的有几个
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit
//写入数字正确，但是位置不对的有几个
Edit3: TEdit;
Label3: TLabel;
Button2: TButton;
Memo1: TMemo
//用来列出所有可能的数字
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
MYNUMBER:Integer;//猜的数字数量
RightP:Integer;//位置正确的数量
RightN:Integer;//个数正确的数量
NumListO:TStringList;//原始列表
NumListT:TStringList;//临时列表
{ Private declarations }
public
procedure InitNumbers(n:Integer)
//初始化数字，n=3,4,5,6
function PushNumber:String
//猜数字
procedure CheckNumber(n:Integer)
//根据人工填入的数字进行判断
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Procedure TForm1.CheckNumber(n:Integer);
var
LastGuess:String;
i,j,k:Integer;
PGuess,NGuess:Integer;
begin
NumListT.Clear;
PGuess:=0;
NGuess:=0;
RightP:=StrToInt(Edit1.Text);
RightN:=StrToInt(Edit2.Text);
LastGuess:=Edit3.Text;
for i:=0 to NumListO.Count-1 do
begin
for j:=1 to n do
begin
if NumListO.Strings[j]=LastGuess[j] then
Inc(PGuess);
for k:=1 to n do
if (NumListO.Strings[j]=LastGuess[k]) and (j<>k) then
inc(NGuess);
end;

if (NGuess=RightN) and (PGuess=RightP) then
begin
NumListT.Add(NumListO.Strings);
end;
NGuess:=0;
PGuess:=0;
end;
Form1.Caption:=IntToStr(NumListT.Count)
//看看总计有多少种可能性
NumListO.Clear;
NumListO.Assign(NumListT);
end;

function TForm1.PushNumber:String;
var
numcount:Integer;
begin
numcount:=NumListO.Count;
if numcount>0 then
begin
Randomize;
Result:=NumListO.Strings[Random(NumCount-1)];
end;

//
end;
procedure TForm1.InitNumbers(n:Integer);
var
i,j,k,l,m,o:Integer;
begin
NumListO.Clear;
for i:=0 to 9 do
for j:=0 to 9 do
if j<>i then
for k:=0 to 9 do
if (k<>j) and (k<>i) then
if n=3 then
NumListO.Add(IntToStr(i)+IntToStr(j)+IntToStr(k))
else
for l:=0 to 9 do
if (l<>i) and (l<>j) and (l<>k) then
begin
if n=4 then
NumListO.Add(IntToStr(i)+IntToStr(j)+IntToStr(k)+IntToStr(l))
else
for m:=0 to 9 do
if (m<>i) and (m<>j) and (m<>k) and (m<>l) then
if n=5 then
NumListO.Add(IntToStr(i)+IntToStr(j)+IntToStr(k)+IntToStr(l)+IntToStr(m))
else
for o:=0 to 9 do
if (o<>i) and (o<>j) and (o<>k) and (o<>l) and (o<>m) then
NumListO.Add(IntToStr(i)+IntToStr(j)+IntToStr(k)+IntToStr(l)+IntToStr(m)+IntToStr(o));
end;

end;
procedure TForm1.Button1Click(Sender: TObject);

begin
CheckNumber(MYNUMBER);
Edit3.Text:=PushNumber;
Memo1.Lines.Clear;
Memo1.Lines.Assign(NumListO);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
NumListO:=TStringList.Create;
NumListT:=TStringList.Create;
MYNUMBER:=6;
initNumbers(MYNUMBER);
Edit3.Text:=PushNumber;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
initnumbers(MYNUMBER);
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:=PushNumber;
end;

end.

Town:
穷举排除法行是肯定可以的，问题是速度，如果猜的是六位数，第一次要花上好
几分钟的时间，之后就一次比一次少。但第一次也实在太久了，我以前用VFP做过，
大约要5－7分钟

啊? 那是不是你的机器太差了，呵呵。 我用6位数字，也就3秒钟的事，呵呵。
（我的机器 Dell Inspiron5000 笔记本, pIII 750 , 128M内存）
当然，3秒钟实际上也确实有点慢， 我也不知道怎样更好些。 当然，这纯粹
是为了做程序而做程序了。 因为实际的游戏中， 只猜4个和5个数字会比较好玩，
6个数字就很变态了，呵呵。

To Town:
如果是猜六位数的话，第一次猜时要在012345与987654之间选出所有没有重复数字的
数字，这一过程我想就得约十分钟，数字太多了。
　　我的机器是赛扬366，192内存，总不会比你的差几十倍这么多吧？

那我不知道啊～～。 你可以看我前面贴的代码， 我就是用6位数字试验的啊～
共有151200个数字， 用时2.7秒
procedure TForm1.FormCreate(Sender: TObject);
begin
NumListO:=TStringList.Create;
NumListT:=TStringList.Create;
MYNUMBER:=6;//6位数字
initNumbers(MYNUMBER);
Edit3.Text:=PushNumber;
end;

用程序计算了一下初始化数字需要的时间 :

MYNUMBER:=6;
iii:=Gettickcount;
initNumbers(MYNUMBER);
iii:=GetTickCount-iii;
Form1.Caption:=IntToStr(iii);

结果为:
6位数字 1171， 也就是说， 初始化数字这部分耗时不到1.2秒
5位数字 190 也就是不到0.2秒
4位数字 30 也就是0.03秒

各位不会都用穷举法吧？
gz

Town:
我发现问题了，我用了ListBox，把每一个数字一次次地加到列表中去，速度就慢了，
改为TStringList，就正常了，也是几秒种。