猜数字问题的简单解法

iamlimeng

猜数字游戏是一个比较老的智力游戏，较早出现在文曲星上，曾经流行过，规则如下：

由电脑随机生成一个由0-9组成的四位数（规则：可以由0开头，不能有重复数字，比如1123就不符合规则，0123符合规则），每猜一个数字，电脑就根据这个数字给出几A几B，其中A前面的数字表示数字和位置均正确的数的个数，而B前的数字表示数字正确而位置不对的数的个数。如正确答案为5234 而猜的人猜 5346，则是 1A2B，其中有一个5的位置对了，记为1A，而3和4这两个数字对了，而位置没对，因此记为 2B，合起来就是 1A2B。接着猜的人再根据出题者的几A几B继续猜，直到猜中（即 4A0B）为止。

步数计算规则：程序提示4A0B为最后一步，而不是以已经知道答案那一步为最后一步。

到目前为止，已知的解法是最多猜7步全中，平均5.213步。这种解法不是通过算法实现的，而是统计得来的，个人认为如果算法优秀，还有提升空间。

已知的算法比较多，比如可能集递归法，最大信息量法、最坏情况指标法等。本人实现的最佳算法：最多猜8步全中，平均5.295步。可能集递归法速度最快，最多猜8步全中，平均5.442步。统计方式为：把所有可能的5040个数字循环猜一遍，然后进行统计。

游戏见附件。Perl实现的代码我也有，但由于不是本人所写，故不公布。将我下面求解的代码修改即可轻松实现。

可能集递归法代码：

1. #!/usr/bin/perl -w
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. #生成有效数字集
   
7. my $number = '0123';
   
8. my @valid;  #5040个有效数字
   
9. while (length($number) == 4) {
   
10.         my $valid = 1;
    
11.         foreach (split('',$number)) {
    
12.                  my $counts = () = ($number =~ /$_/g);
    
13.                  if ($counts > 1) {
    
14.                          $valid = 0;
    
15.                          last;
    
16.                  }
    
17.          }
    
18.          push(@valid,"$number") if ($valid);
    
19.          $number++;
    
20. }
    
21. 
    
22. #求解，并进行统计输出
    
23. my @valid_temp = @valid;
    
24. my %count_guess = ();
    
25. open(FH,">count_guess.xls");
    
26. print FH "Answer Number\tGuess Times";
    
27. foreach (1..8) { print FH "\tStep $_"; }
    
28. print FH "\n";
    
29. 
    
30. foreach my $answer(@valid) {
    
31.          my $n = 1;
    
32.          my $steps = '';
    
33.         while (1) {
    
34.                  my $number;
    
35.                   if ($n == 1) { $number = $valid[0]; }
    
36.                   else { $number = $valid_temp[int(@valid_temp/2)]; }
    
37.                   #每次取可能集中居中的数字为下一次猜的数字
    
38.                   #若随机取，最多步数为9步，个别情况为10步
    
39.                  my $judge = judge($number,$answer);
    
40.                  guess($number,$judge);
    
41.                   $steps .= "\t$number:$judge";
    
42.                   if ($judge eq '4A0B') {
    
43.                          $count_guess{$n}++;
    
44.                         print FH "$answer\t$n$steps\n";
    
45.                         last;
    
46.                   }
    
47.                   $n++;
    
48.         }
    
49.          print "$answer\t$n\n";
    
50.          @valid_temp = @valid;
    
51. }
    
52. my ($guess_times,$guess_values) = (0,0);
    
53. print FH "\n";
    
54. foreach my $n (sort keys %count_guess) {
    
55.         $guess_times += $count_guess{$n};
    
56.         $guess_values += $n * $count_guess{$n};
    
57.         print FH "$n\t$count_guess{$n}\n";
    
58. }
    
59. print FH "Total\t$guess_times\n";
    
60. print FH "Average\t",sprintf("%.3f",$guess_values/$guess_times),"\n";
    
61. close FH;
    
62. 
    
63. 
    
64. sub guess {   #求可能集
    
65.         my ($number,$judge) = @_;
    
66.          my @valid_search = @valid_temp;
    
67.          @valid_temp = ();
    
68.          foreach my $no (@valid_search) {
    
69.                  push(@valid_temp,$no) if (judge($no,$number) eq $judge);
    
70.          }
    
71. }
    
72. 
    
73. sub judge {  #求判断码
    
74.          my($n,$g) = @_;
    
75.          my ($a,$b)=(0,0);
    
76.          foreach (0..3) {
    
77.                  my $str_n = substr($n,$_,1);
    
78.                  if ($str_n eq substr($g,$_,1)) { $a++; }
    
79.                  elsif ($g =~ /$str_n/) { $b++; }
    
80.          }
    
81.          return ($a.'A'.$b.'B');
    
82. }

复制代码

个人以为，通过优秀算法，有望将最大猜测步数减少到6步以内，若大家有更好的算法，希望共同探讨。
Guess_Number.rar (9.73 KB, 下载次数: 91)

2013-10-28 14:08 上传

点击文件名下载附件

104359176

very good!

rubyish

谢谢 lz ,学习了。来个山寨版~

1. #!/usr/bin/perl
   
2. use 5.018;
   
3. my @gather = grep !/(\d).*\1/, '0123' .. '9876';
   
4. my $score = -1;
   
5. sub correct { @gather <= 1 }
   
6. sub get {
   
7.     my $num = shift;
   
8.     while (1) {
   
9.         $_ = do { print "$score | $num | AB = "; <> };
   
10.         /^\s*(\d)\s*(\d)\s*$/ && $1 + $2 <= 4 && return $1, $2;
    
11.         say "$score | wrong  AB !!";
    
12.     }
    
13. }
    
14. 
    
15. sub pick {
    
16.     my ( $pick, @pick ) = @gather[ rand @gather ];
    
17.     my ( $A, $B ) = get $pick, $score++;
    
18.     $score-- if $A == 4 and $B == 0;
    
19.     for my $ok (@gather ){
    
20.         my $a =
    
21.           grep substr( $ok, $_, 1 ) eq substr( $pick, $_, 1 ), 0 .. 3;
    
22.         $A == $a or next;
    
23.         my $ab = () = $ok =~ /[$pick]/g;
    
24.         $B == $ab - $a and push @pick, $ok;
    
25.     }
    
26.     @gather = @pick;
    
27. }
    
28. 
    
29. pick until correct;
    
30. 
    
31. say $/, @gather ? ++$score . " [ @gather ] score: $score" : 'you liar';
    
32. 
    

复制代码

play 法:

1. 0 | 9340 | AB = 02
   
2. 1 | 3164 | AB = 12
   
3. 2 | 3691 | AB = 02
   
4. 3 | 4563 | AB = 02
   
5. 4 | 1734 | AB = 30
   
6. 5 | 1834 | AB = 30
   
7. 
   
8. 6 [ 1234 ] score: 6
   

复制代码

iamlimeng

回复 3# rubyish

实现得真不错，很简洁，赞！

按标准规则，计次应该从1开始，而不是0.

mcshell

学习了~~~~

pitonas

学习了

iamlimeng

有没有不学习的，提供个好算法！

pitonas

大牛，请写个
最大信息量法
最坏情况指标法
谢谢