Board logo

标题: [技术讨论] Bulls and Cows 猜数字游戏 搜索树生成算法 [打印本页]

作者: 523066680    时间: 2018-9-14 11:48     标题: Bulls and Cows 猜数字游戏 搜索树生成算法

本帖最后由 523066680 于 2018-9-14 12:06 编辑

论坛曾经有过大量讨论,参考链接
http://bbs.bathome.net/thread-44826-1-2.html
http://bbs.bathome.net/thread-44983-1-1.html

同时参考 a20150604 提供的资料
http://slovesnov.users.sourceforge.net/bullscows/bullscows.pdf
http://slovesnov.users.sourceforge.net/index.php?bullscows_tree,english,avgBullsCows
作者: 523066680    时间: 2018-9-14 11:51

本帖最后由 523066680 于 2018-9-14 11:52 编辑

代码是去年8月份的,现在分享出来

Perl (内联C,提高判断效率),分别生成 Perl 哈希结构 和 JSON 格式的搜索树。
  1. =info
  2.     生成最平均指标搜索树
  3.     Code-by : 523066680
  4.        Date : 2017-08
  5. =cut
  6. use List::Util qw/max sum/;
  7. use JSON;
  8. use Inline C;
  9. use IO::Handle;
  10. use Data::Dumper;
  11. use File::Slurp;
  12. use Time::HiRes qw/sleep/;
  13. STDOUT->autoflush(1);
  14. $Data::Dumper::Indent = 1;
  15. #生成排列
  16. our @orders;
  17. permute( [0 .. 9] , [], 4, \@orders);
  18. #生成树
  19. print "Make tree\n";
  20. my $tree;
  21. $tree = { "0123" => {} };
  22. maketree( $tree, \@orders, 0 );
  23. #导出
  24. print "Dump tree\n";
  25. write_file("./Tree_avg2.perl.txt", Dumper $tree);
  26. write_file("./Tree_avg2.json.txt", encode_json($tree) );
  27. sub maketree
  28. {
  29.     our @orders;
  30.     my $orders;
  31. my ($ref, $arr, $lv) = @_;
  32. my $AB = "00";
  33.     my %keymap;
  34.     my %hash;
  35.     my $minkey;
  36.     my $minval = 10000000;
  37.     my $amount;
  38.     if ($lv == 0) { $orders = ["0123"] }
  39.     else          { $orders = \@orders }
  40.     #根据参考指标,选出最优的测试项
  41.     for my $e ( @$orders )
  42.     {
  43.         $amount = 0;
  44.         %hash = ();
  45.         for my $k ( @$arr )
  46.         {
  47.             bullcow( $k, $e, $AB );
  48.             $hash{$AB}++;
  49.         }
  50.         #各项反馈下子集的平方和作为参考,值越小,分布越平坦,越均匀
  51.         grep { $amount += $_ * $_ } values %hash;
  52.         $amount = $amount/scalar(keys %hash);
  53.         $keymap{$e} = $amount;
  54.         if ($amount < $minval)
  55.         {
  56.          $minval = $amount;
  57.          $minkey = $e;
  58.         }
  59.     }
  60.     #如果筛选集中有符合条件的项,优先选择
  61.     for my $k ( @$arr )
  62.     {
  63.     if ( $keymap{$k} == $minval ) { $minkey = $k; last; }
  64.     }
  65.     #建立反馈项和缩小集合组
  66.     for my $k ( @$arr )
  67.     {
  68.         #删除 $minkey 以外的项(当前层)
  69.         delete $ref->{$k} if ($k ne $minkey);
  70.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集
  71.         bullcow( $minkey, $k, $AB );   
  72.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );
  73.     }
  74.    
  75.     for my $ab ( keys %{ $ref->{ $minkey } } )
  76.     {
  77.         printf " $lv -> $ab, %d\n", $#$arr;
  78.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );
  79.     }
  80. }
  81. sub permute
  82. {
  83.     my ( $a, $b, $n, $aref ) = @_;
  84.     my $last = $#$a;
  85.     if ( $#$b >= ($n-1) )
  86.     {
  87.         push @$aref, join("", @$b);
  88.         return;
  89.     }
  90.     for my $idx ( 0 .. $last )
  91.     {
  92.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
  93.     }
  94. }
  95. __END__
  96. __C__
  97. void bullcow(char *stra, char *strb, char *AB)
  98. {
  99.     int idx;
  100.     char a = '0';
  101.     char b = '0';
  102.     for ( idx = 0; idx < 4; idx++ )
  103.     {
  104.         if ( stra[idx] == strb[idx] )
  105.             a++;
  106.         else
  107.             if ( strchr(stra, strb[idx]) != 0 )
  108.             {
  109.                 b++;
  110.             }
  111.     }
  112.     AB[0] = a;
  113.     AB[1] = b;
  114. }
复制代码
  1. use JSON;
  2. use Data::Dumper;
  3. use IO::Handle;
  4. use File::Slurp;
  5. use Time::HiRes qw/sleep time/;
  6. STDOUT->autoflush(1);
  7. $Data::Dumper::Indent = 1;
  8. my $time_a = time();
  9. our $nums = [];
  10. our @orders_init;
  11. our @orders;
  12. permute( [0 .. 9] , [], 4, \@orders_init);
  13. my $json;
  14. my $tree;
  15. my $struct = read_file("Tree_avg2.perl.txt");
  16. my $tree = eval $struct;
  17. my $iter = 0;
  18. my $loopi = 0;
  19. my $AB;
  20. my $guess;
  21. my $ref;
  22. my %record;
  23. my $times;
  24. while ( $iter <= $#orders_init )
  25. {
  26.     $ref = $tree;
  27.     $nums = $orders_init[$iter];
  28.     print "Target Number: $nums\n";
  29.     ($guess) = keys %$ref;
  30.     #print $guess;
  31.     $times = 0;
  32.     SUB: while (1)
  33.     {
  34.         $loopi++;
  35.         $times++;
  36.         $AB = guess( $nums, $guess );
  37.         print "[$AB] $guess\n";
  38.         last SUB if ( $AB eq "40" );
  39.         if ( exists $ref->{$guess}{$AB} )
  40.         {
  41.             $ref = $ref->{$guess}{$AB};
  42.             ($guess) = keys %{$ref};
  43.         }
  44.         else
  45.         {
  46.             printf "there is some problem\n";
  47.             exit;
  48.         }
  49.         if ($guess eq "")
  50.         {
  51.             printf "there is some problem\n";
  52.             exit;
  53.         }
  54.         #print "-> $guess\n";
  55.     }
  56.     $record{$times}++;
  57.     $iter++;
  58. }
  59. printf "Times: %d, average: %f \n", $loopi, $loopi/5040;
  60. for my $k ( sort keys %record )
  61. {
  62.     printf "%s, %s\n", $k, $record{$k};
  63. }
  64. printf "%.3f\n", time()-$time_a;
  65. sub guess
  66. {
  67.     my ($nums, $guess) = @_;
  68.     my ($A, $B) = (0, 0);
  69.     my $t;
  70.     for my $i ( 0 .. 3 )
  71.     {
  72.         if ( substr($nums, $i, 1) eq substr($guess, $i, 1) )
  73.         {
  74.             $A++;
  75.         }
  76.         else
  77.         {
  78.             $t = substr($guess, $i, 1);
  79.             $B++ if ( $nums =~/$t/ );
  80.         }
  81.         $i++;
  82.     }
  83.     return $A . $B;
  84. }
  85. sub permute
  86. {
  87.     my ( $a, $b, $n, $aref ) = @_;
  88.     my $last = $#$a;
  89.     if ( $#$b >= ($n-1) )
  90.     {
  91.         push @$aref, join("", @$b);
  92.         return;
  93.     }
  94.     for my $idx ( 0 .. $last )
  95.     {
  96.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
  97.     }
  98. }
复制代码

Times: 26537, average: 5.265278
1, 1
2, 8
3, 66
4, 574
5, 2430
6, 1852
7, 108
8, 1

作者: 523066680    时间: 2018-9-14 11:55

本帖最后由 523066680 于 2018-9-14 12:03 编辑

Landy 方案
  1. =info
  2.     Landy方案
  3.     Code-by : 523066680
  4.        Date : 2017-08
  5. =cut
  6. use List::Util qw/max sum min/;
  7. use JSON;
  8. use Inline C;
  9. use IO::Handle;
  10. use Data::Dumper;
  11. use File::Slurp;
  12. use Time::HiRes qw/sleep/;
  13. STDOUT->autoflush(1);
  14. $Data::Dumper::Indent = 1;
  15. #生成排列
  16. our @orders;
  17. permute( [0 .. 9] , [], 4, \@orders);
  18. #生成树
  19. print "Make tree\n";
  20. my $tree;
  21. $tree = { "0123" => {} };
  22. maketree( $tree, \@orders, 0 );
  23. #导出
  24. print "Dump tree\n";
  25. write_file("./Tree_landy.perl.txt", Dumper $tree);
  26. write_file("./Tree_landy.json.txt", encode_json($tree) );
  27. sub maketree
  28. {
  29.     our @orders;
  30.     my $orders;
  31. my ($ref, $arr, $lv) = @_;
  32. my $AB = "00";
  33.     my %keymap;
  34.     my %hash;
  35.     my $minkey;
  36.     my $minval = 10000000;
  37.     my $amount;
  38.     if ($lv == 0) { $orders = ["0123"] }
  39.     else          { $orders = \@orders }
  40.     #根据参考指标,选出最优的测试项
  41.     for my $e ( @$orders )
  42.     {
  43.         $amount = 0;
  44.         %hash = ();
  45.         for my $k ( @$arr )
  46.         {
  47.             bullcow( $k, $e, $AB );
  48.             $hash{$AB}++;
  49.         }
  50.         #Times: 26439, average: 5.245833
  51.         grep { $amount += $_ * landy($_) } values %hash;
  52.         if ( exists $ref->{$e} ) { $amount -= 1.0 }
  53.         $keymap{$e} = $amount;
  54.         if ($amount < $minval)
  55.         {
  56.          $minval = $amount;
  57.          $minkey = $e;
  58.         }
  59.     }
  60.     #建立反馈项和缩小集合组
  61.     for my $k ( @$arr )
  62.     {
  63.         #删除 $minkey 以外的项(当前层)
  64.         delete $ref->{$k} if ($k ne $minkey);
  65.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集
  66.         bullcow( $minkey, $k, $AB );   
  67.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );
  68.     }
  69.    
  70.     for my $ab ( keys %{ $ref->{ $minkey } } )
  71.     {
  72.         printf " $lv -> $ab, %d\n", $#$arr;
  73.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );
  74.     }
  75. }
  76. sub permute
  77. {
  78.     my ( $a, $b, $n, $aref ) = @_;
  79.     my $last = $#$a;
  80.     if ( $#$b >= ($n-1) )
  81.     {
  82.         push @$aref, join("", @$b);
  83.         return;
  84.     }
  85.     for my $idx ( 0 .. $last )
  86.     {
  87.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
  88.     }
  89. }
  90. sub landy
  91. {
  92.     my $n = shift;
  93.     my $x = 0.0;
  94.     my $plus = 1.0;
  95.     my $pow;
  96.     return 1 if ($n == 1);
  97.     while (1)
  98.     {
  99.         $pow = $x ** $x;
  100.         if ( $pow < $n )
  101.         {
  102.             $x += $plus;
  103.         }
  104.         elsif ( $pow > $n )
  105.         {
  106.             $x -= $plus;
  107.             $plus *= 0.1;
  108.         }
  109.         else
  110.         {
  111.             last;
  112.         }
  113.         last if ($plus < 0.000001);
  114.     }
  115.     return $x;
  116. }
  117. __END__
  118. __C__
  119. void bullcow(char *stra, char *strb, char *AB)
  120. {
  121.     int idx;
  122.     char a = '0';
  123.     char b = '0';
  124.     for ( idx = 0; idx < 4; idx++ )
  125.     {
  126.         if ( stra[idx] == strb[idx] )
  127.             a++;
  128.         else
  129.             if ( strchr(stra, strb[idx]) != 0 )
  130.             {
  131.                 b++;
  132.             }
  133.     }
  134.     AB[0] = a;
  135.     AB[1] = b;
  136. }
复制代码


Times: 26439, average: 5.245833
1, 1
2, 7
3, 79
4, 598
5, 2438
6, 1815
7, 101
8, 1

作者: 523066680    时间: 2018-9-14 11:58

Log 估值方案
  1. =info
  2.     生成搜索树 - log估值方案
  3.     Code-by : 523066680
  4.        Date : 2017-08
  5. =cut
  6. use List::Util qw/max sum min/;
  7. use JSON;
  8. use Inline C;
  9. use IO::Handle;
  10. use Data::Dumper;
  11. use File::Slurp;
  12. use Time::HiRes qw/sleep/;
  13. STDOUT->autoflush(1);
  14. $Data::Dumper::Indent = 1;
  15. $Data::Dumper::Sortkeys = 1;
  16. #生成排列
  17. our @orders;
  18. permute( [0 .. 9] , [], 4, \@orders);
  19. #生成树
  20. print "Make tree\n";
  21. my $tree;
  22. $tree = { "0123" => {} };
  23. maketree( $tree, \@orders, 0 );
  24. #导出
  25. print "Dump tree\n";
  26. write_file("./Tree_log.perl.txt", Dumper $tree);
  27. #write_file("./Tree_log.json.txt", encode_json($tree) );
  28. sub maketree
  29. {
  30.     our @orders;
  31.     my $orders;
  32. my ($ref, $arr, $lv) = @_;
  33. my $AB = "00";
  34.     my %keymap;
  35.     my %hash;
  36.     my $minkey;
  37.     my $minval = 10000000;
  38.     my $amount;
  39.     if ($lv == 0) { $orders = ["0123"] }
  40.     else          { $orders = \@orders }
  41.     #根据参考指标,选出最优的测试项
  42.     for my $e ( @$orders )
  43.     {
  44.         $amount = 0;
  45.         %hash = ();
  46.         for my $k ( @$arr )
  47.         {
  48.             bullcow( $k, $e, $AB );
  49.             $hash{$AB}++;
  50.         }
  51.         #5.243
  52.         grep { $amount += $_ * log($_) } values %hash;
  53.         #$amount /= scalar(keys %hash);
  54.         #5.239
  55.         if ( exists $ref->{$e} ) { $amount -= 2*log(2) }
  56.         $keymap{$e} = $amount;
  57.         #if ($amount < $minval) 26408
  58.         if ($amount < $minval) #26405
  59.         {
  60.          $minval = $amount;
  61.          $minkey = $e;
  62.         }
  63.     }
  64.     #建立反馈项和缩小集合组
  65.     for my $k ( @$arr )
  66.     {
  67.         #删除 $minkey 以外的项(当前层)
  68.         delete $ref->{$k} if ($k ne $minkey);
  69.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集
  70.         bullcow( $minkey, $k, $AB );   
  71.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );
  72.     }
  73.    
  74.     for my $ab ( keys %{ $ref->{ $minkey } } )
  75.     {
  76.         printf " $lv -> $ab, %d\n", $#$arr;
  77.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );
  78.     }
  79. }
  80. sub permute
  81. {
  82.     my ( $a, $b, $n, $aref ) = @_;
  83.     my $last = $#$a;
  84.     if ( $#$b >= ($n-1) )
  85.     {
  86.         push @$aref, join("", @$b);
  87.         return;
  88.     }
  89.     for my $idx ( 0 .. $last )
  90.     {
  91.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
  92.     }
  93. }
  94. __END__
  95. __C__
  96. void bullcow(char *stra, char *strb, char *AB)
  97. {
  98.     int idx;
  99.     char a = '0';
  100.     char b = '0';
  101.     for ( idx = 0; idx < 4; idx++ )
  102.     {
  103.         if ( stra[idx] == strb[idx] )
  104.             a++;
  105.         else
  106.             if ( strchr(stra, strb[idx]) != 0 )
  107.             {
  108.                 b++;
  109.             }
  110.     }
  111.     AB[0] = a;
  112.     AB[1] = b;
  113. }
复制代码


Times: 26408, average: 5.239683
1, 1
2, 7
3, 70
4, 647
5, 2400
6, 1811
7, 103
8, 1





欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2