在不受限内存情况猜数字次数最小的算法

使用列出所有可能解集，然后收敛解集的方法

===================

Guess_Number_Lib.pas

Unit Guess_Number_Lib;
{$mode Delphi}
{$S+,Q+,N+}

Interface
Type
Get_Back = record
A , B : Integer;
End;

Function Init : Integer;
Function Guess(Const g : array of integer) :Get_Back;
Procedure OverGame;

Implementation
Const
Fin = 'Guess.in';
Fout = 'Guess.out';
FLog = 'Guess.log';
// Flog = '';

Var
Pin , Pout , PLog :Text;
Ans : array [0..10] ofInteger;
len : Integer;
Guess_Tot : Longint;
vis : array [0..9] ofBoolean;

Function Init : Integer;
Var
rand , i : Integer;

Begin
Randomize;
ASSIGN(PLOG,FLOG);REWRITE(PLOG);
fillchar(vis,sizeof(vis),False);
Guess_Tot := 0;

ASSIGN(PIN,FIN);RESET(PIN);
readln(pin,len);
CLOSE(PIN);

for i:=1 to len do
begin
repeat
rand := random(10);
until not vis[rand];
vis[rand] := True;
ans[i] := rand;
end;
Result := Len;

writeln(plog,'Game Started.');
writeln(plog,'Code by Yizer');
for i:=1 to len do
if i<>len then
write(plog,ans[i],' ')
else
writeln(plog,ans[i]);

End;

Function Guess(Const g : array of integer) : Get_Back;
Var
i : Integer;
tmp : array [0..10] of Integer;
Begin
Inc(Guess_Tot);
writeln(plog,Guess_Tot,':');
write(plog,'You guess : ');
for i:=1 to len do
if i<>len then
write(plog,g[i],' ')
else
writeln(plog,g[i]);

Result.A := 0;
Result.B := 0;
Fillchar(tmp,sizeof(tmp),0);

for i:=1 to len do
if (g[i]>-1) and(g[i]<10) then
inc(tmp[g[i]])
else
begin
writeln(plog,'Invialid parameters');
exit;
end;

for i:=0 to 9 do
if tmp[i]>1 then
begin
writeln(plog,'Invialidparameters');
exit;
end;

for i:=1 to len do
if g[i] = ans[i] then
inc(result.a)
else
if vis[g[i]] then
inc(result.b);

writeln(plog,'Ans : ',result.a,'A',result.b,'B');

End;

Procedure OverGame;
Begin
writeln(plog,'Game Over.');
writeln(plog,'Thank you for playing.');
ASSIGN(POUT,FOUT);REWRITE(POUT);
writeln(pout,Guess_Tot);
CLOSE(POUT);
CLOSE(PLOG);
End;

BEGIN
END.

===============

Main.pas

Program Guess_Number;
{$mode delphi}
Uses
Guess_Number_Lib;

Type
Tgue = array [0..10] of Integer;

Var
len : Integer;
G : Tgue;
I : Integer;
ans , ans2 : Get_Back;
Flag : array [0..3628800] of Boolean;
f : array [0..3628800] of Tgue;
Tot : Longint;
visit : array [0..10] of Boolean;
rand : Longint;

Procedure MD(x : Integer);
Var
i : Longint;
Begin
if x = len+1 then
begin
inc(tot);
f[tot] := g;
end
else
for i:=0 to 9 do
if not visit[i] then
begin
g[x] := i;
visit[i] := True;
MD(x+1);
visit[i] := False;
end;
End;

Function Cmp(s1 , s2 : Tgue) : Get_Back;
Var
i : Integer;
Begin
Fillchar(visit,sizeof(visit),False);
for i:=1 to len do
visit[s1[i]] := True;

Result.a := 0;
Result.b := 0;

for i:=1 to len do
if s1[i]=s2[i] then
inc(Result.a)
else
if visit[s2[i]] then
inc(Result.b);

End;

BEGIN
Randomize;
len := Init;
MD(1);
Repeat
repeat
rand := random(tot) + 1;
until not flag[rand];
flag[rand] := True;
ans := Guess(f[rand]);
for i:=1 to tot do
if not flag[i] then
begin
ans2 := cmp(f[i],f[rand]);
if (ans2.a<>ans.a)or (ans2.b<>ans.b) then
flag[i] := True;
end;
Until ans.a = len;
Overgame;
END.