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

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

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

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.