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. 

  4.     Code-by : 523066680

  5.        Date : 2017-08

  6. =cut

  7. 

  8. use List::Util qw/max sum/;

  9. 

  10. use JSON;

  11. use Inline C;

  12. use IO::Handle;

  13. use Data::Dumper;

  14. use File::Slurp;

  15. use Time::HiRes qw/sleep/;

  16. STDOUT->autoflush(1);

  17. $Data::Dumper::Indent = 1;

  18. 

  19. #生成排列

  20. our @orders;

  21. permute( [0 .. 9] , [], 4, \@orders);

  22. 

  23. #生成树

  24. print "Make tree\n";

  25. my $tree;

  26. $tree = { "0123" => {} };

  27. maketree( $tree, \@orders, 0 );

  28. 

  29. #导出

  30. print "Dump tree\n";

  31. write_file("./Tree_avg2.perl.txt", Dumper $tree);

  32. write_file("./Tree_avg2.json.txt", encode_json($tree) );

  33. 

  34. sub maketree

  35. {

  36.     our @orders;

  37.     my $orders;

  38. 	my ($ref, $arr, $lv) = @_;

  39. 	my $AB = "00";

  40.     my %keymap;

  41.     my %hash;

  42.     my $minkey;

  43.     my $minval = 10000000;

  44.     my $amount;

  45. 

  46.     if ($lv == 0) { $orders = ["0123"] }

  47.     else          { $orders = \@orders }

  48. 

  49.     #根据参考指标，选出最优的测试项

  50.     for my $e ( @$orders )

  51.     {

  52.         $amount = 0;

  53.         %hash = ();

  54. 

  55.         for my $k ( @$arr )

  56.         {

  57.             bullcow( $k, $e, $AB );

  58.             $hash{$AB}++;

  59.         } 

  60. 

  61.         #各项反馈下子集的平方和作为参考，值越小，分布越平坦，越均匀

  62.         grep { $amount += $_ * $_ } values %hash;

  63.         $amount = $amount/scalar(keys %hash);

  64. 

  65.         $keymap{$e} = $amount;

  66. 

  67.         if ($amount < $minval)

  68.         {

  69.         	$minval = $amount;

  70.         	$minkey = $e;

  71.         }

  72.     }

  73. 

  74.     #如果筛选集中有符合条件的项，优先选择

  75.     for my $k ( @$arr )

  76.     {

  77.     	if ( $keymap{$k} == $minval ) { $minkey = $k; last; }

  78.     }

  79. 

  80.     #建立反馈项和缩小集合组

  81.     for my $k ( @$arr )

  82.     {

  83.         #删除 $minkey 以外的项（当前层）

  84.         delete $ref->{$k} if ($k ne $minkey);

  85. 

  86.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集

  87.         bullcow( $minkey, $k, $AB );    

  88.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );

  89.     }

  90.     

  91.     for my $ab ( keys %{ $ref->{ $minkey } } )

  92.     {

  93.         printf " $lv -> $ab, %d\n", $#$arr;

  94.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );

  95.     }

  96. }

  97. 

  98. sub permute

  99. {

  100.     my ( $a, $b, $n, $aref ) = @_;

  101.     my $last = $#$a;

  102. 

  103.     if ( $#$b >= ($n-1) )

  104.     {

  105.         push @$aref, join("", @$b);

  106.         return;

  107.     }

  108. 

  109.     for my $idx ( 0 .. $last )

  110.     {

  111.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );

  112.     }

  113. }

  114. 

  115. __END__

  116. __C__

  117. void bullcow(char *stra, char *strb, char *AB)

  118. {

  119.     int idx;

  120.     char a = '0';

  121.     char b = '0';

  122. 

  123.     for ( idx = 0; idx < 4; idx++ )

  124.     {

  125.         if ( stra[idx] == strb[idx] )

  126.             a++;

  127.         else

  128.             if ( strchr(stra, strb[idx]) != 0 )

  129.             {

  130.                 b++;

  131.             }

  132.     }

  133. 

  134.     AB[0] = a;

  135.     AB[1] = b;

  136. }
复制代码
  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. 

  8. $Data::Dumper::Indent = 1;

  9. 

  10. my $time_a = time();

  11. 

  12. our $nums = [];

  13. our @orders_init;

  14. our @orders;

  15. permute( [0 .. 9] , [], 4, \@orders_init);

  16. 

  17. my $json;

  18. my $tree;

  19. my $struct = read_file("Tree_avg2.perl.txt");

  20. my $tree = eval $struct;

  21. 

  22. my $iter = 0;

  23. my $loopi = 0;

  24. my $AB;

  25. my $guess;

  26. my $ref;

  27. my %record;

  28. my $times;

  29. 

  30. while ( $iter <= $#orders_init )

  31. {

  32.     $ref = $tree;

  33.     $nums = $orders_init[$iter];

  34.     print "Target Number: $nums\n";

  35. 

  36.     ($guess) = keys %$ref;

  37.     #print $guess;

  38. 

  39.     $times = 0;

  40.     SUB: while (1)

  41.     {

  42.         $loopi++;

  43.         $times++;

  44.         $AB = guess( $nums, $guess );

  45.         print "[$AB] $guess\n";

  46. 

  47.         last SUB if ( $AB eq "40" );

  48. 

  49.         if ( exists $ref->{$guess}{$AB} )

  50.         {

  51.             $ref = $ref->{$guess}{$AB};

  52.             ($guess) = keys %{$ref};

  53.         }

  54.         else 

  55.         {

  56.             printf "there is some problem\n";

  57.             exit;

  58.         }

  59. 

  60.         if ($guess eq "")

  61.         {

  62.             printf "there is some problem\n";

  63.             exit;

  64.         }

  65. 

  66.         #print "-> $guess\n";

  67.     }

  68.     $record{$times}++;

  69. 

  70.     $iter++;

  71. }

  72. 

  73. printf "Times: %d, average: %f \n", $loopi, $loopi/5040;

  74. 

  75. for my $k ( sort keys %record )

  76. {

  77.     printf "%s, %s\n", $k, $record{$k};

  78. }

  79. 

  80. printf "%.3f\n", time()-$time_a;

  81. 

  82. sub guess

  83. {

  84.     my ($nums, $guess) = @_;

  85.     my ($A, $B) = (0, 0);

  86.     my $t;

  87. 

  88.     for my $i ( 0 .. 3 )

  89.     {

  90.         if ( substr($nums, $i, 1) eq substr($guess, $i, 1) )

  91.         {

  92.             $A++;

  93.         }

  94.         else

  95.         {

  96.             $t = substr($guess, $i, 1);

  97.             $B++ if ( $nums =~/$t/ );

  98.         }

  99.         $i++;

  100.     }

  101. 

  102.     return $A . $B;

  103. }

  104. 

  105. sub permute

  106. {

  107.     my ( $a, $b, $n, $aref ) = @_;

  108.     my $last = $#$a;

  109. 

  110.     if ( $#$b >= ($n-1) )

  111.     {

  112.         push @$aref, join("", @$b);

  113.         return;

  114.     }

  115. 

  116.     for my $idx ( 0 .. $last )

  117.     {

  118.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );

  119.     }

  120. }
复制代码

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. 

  4.     Code-by : 523066680

  5.        Date : 2017-08

  6. =cut

  7. 

  8. use List::Util qw/max sum min/;

  9. 

  10. use JSON;

  11. use Inline C;

  12. use IO::Handle;

  13. use Data::Dumper;

  14. use File::Slurp;

  15. use Time::HiRes qw/sleep/;

  16. STDOUT->autoflush(1);

  17. $Data::Dumper::Indent = 1;

  18. 

  19. #生成排列

  20. our @orders;

  21. permute( [0 .. 9] , [], 4, \@orders);

  22. 

  23. #生成树

  24. print "Make tree\n";

  25. my $tree;

  26. $tree = { "0123" => {} };

  27. maketree( $tree, \@orders, 0 );

  28. 

  29. #导出

  30. print "Dump tree\n";

  31. write_file("./Tree_landy.perl.txt", Dumper $tree);

  32. write_file("./Tree_landy.json.txt", encode_json($tree) );

  33. 

  34. sub maketree

  35. {

  36.     our @orders;

  37.     my $orders;

  38. 	my ($ref, $arr, $lv) = @_;

  39. 	my $AB = "00";

  40.     my %keymap;

  41.     my %hash;

  42.     my $minkey;

  43.     my $minval = 10000000;

  44.     my $amount;

  45. 

  46.     if ($lv == 0) { $orders = ["0123"] }

  47.     else          { $orders = \@orders }

  48. 

  49.     #根据参考指标，选出最优的测试项

  50.     for my $e ( @$orders )

  51.     {

  52.         $amount = 0;

  53.         %hash = ();

  54. 

  55.         for my $k ( @$arr )

  56.         {

  57.             bullcow( $k, $e, $AB );

  58.             $hash{$AB}++;

  59.         } 

  60. 

  61.         #Times: 26439, average: 5.245833 

  62.         grep { $amount += $_ * landy($_) } values %hash;

  63.         if ( exists $ref->{$e} ) { $amount -= 1.0 }

  64. 

  65.         $keymap{$e} = $amount;

  66. 

  67.         if ($amount < $minval)

  68.         {

  69.         	$minval = $amount;

  70.         	$minkey = $e;

  71.         }

  72.     }

  73. 

  74.     #建立反馈项和缩小集合组

  75.     for my $k ( @$arr )

  76.     {

  77.         #删除 $minkey 以外的项（当前层）

  78.         delete $ref->{$k} if ($k ne $minkey);

  79. 

  80.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集

  81.         bullcow( $minkey, $k, $AB );    

  82.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );

  83.     }

  84.     

  85.     for my $ab ( keys %{ $ref->{ $minkey } } )

  86.     {

  87.         printf " $lv -> $ab, %d\n", $#$arr;

  88.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );

  89.     }

  90. }

  91. 

  92. sub permute

  93. {

  94.     my ( $a, $b, $n, $aref ) = @_;

  95.     my $last = $#$a;

  96. 

  97.     if ( $#$b >= ($n-1) )

  98.     {

  99.         push @$aref, join("", @$b);

  100.         return;

  101.     }

  102. 

  103.     for my $idx ( 0 .. $last )

  104.     {

  105.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );

  106.     }

  107. }

  108. 

  109. sub landy

  110. {

  111.     my $n = shift;

  112.     my $x = 0.0;

  113.     my $plus = 1.0;

  114.     my $pow;

  115. 

  116.     return 1 if ($n == 1);

  117. 

  118.     while (1)

  119.     {

  120.         $pow = $x ** $x;

  121. 

  122.         if ( $pow < $n )

  123.         {

  124.             $x += $plus;

  125.         }

  126.         elsif ( $pow > $n )

  127.         {

  128.             $x -= $plus;

  129.             $plus *= 0.1;

  130.         }

  131.         else

  132.         {

  133.             last;

  134.         }

  135. 

  136.         last if ($plus < 0.000001);

  137.     }

  138. 

  139.     return $x;

  140. }

  141. __END__

  142. __C__

  143. void bullcow(char *stra, char *strb, char *AB)

  144. {

  145.     int idx;

  146.     char a = '0';

  147.     char b = '0';

  148. 

  149.     for ( idx = 0; idx < 4; idx++ )

  150.     {

  151.         if ( stra[idx] == strb[idx] )

  152.             a++;

  153.         else

  154.             if ( strchr(stra, strb[idx]) != 0 )

  155.             {

  156.                 b++;

  157.             }

  158.     }

  159. 

  160.     AB[0] = a;

  161.     AB[1] = b;

  162. }
复制代码


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. 

  4.     Code-by : 523066680

  5.        Date : 2017-08

  6. =cut

  7. 

  8. use List::Util qw/max sum min/;

  9. 

  10. use JSON;

  11. use Inline C;

  12. use IO::Handle;

  13. use Data::Dumper;

  14. use File::Slurp;

  15. use Time::HiRes qw/sleep/;

  16. STDOUT->autoflush(1);

  17. $Data::Dumper::Indent = 1;

  18. $Data::Dumper::Sortkeys = 1;

  19. 

  20. #生成排列

  21. our @orders;

  22. permute( [0 .. 9] , [], 4, \@orders);

  23. 

  24. #生成树

  25. print "Make tree\n";

  26. my $tree;

  27. $tree = { "0123" => {} };

  28. maketree( $tree, \@orders, 0 );

  29. 

  30. #导出

  31. print "Dump tree\n";

  32. write_file("./Tree_log.perl.txt", Dumper $tree);

  33. #write_file("./Tree_log.json.txt", encode_json($tree) );

  34. 

  35. sub maketree

  36. {

  37.     our @orders;

  38.     my $orders;

  39. 	my ($ref, $arr, $lv) = @_;

  40. 	my $AB = "00";

  41.     my %keymap;

  42.     my %hash;

  43.     my $minkey;

  44.     my $minval = 10000000;

  45.     my $amount;

  46. 

  47.     if ($lv == 0) { $orders = ["0123"] }

  48.     else          { $orders = \@orders }

  49. 

  50.     #根据参考指标，选出最优的测试项

  51.     for my $e ( @$orders )

  52.     {

  53.         $amount = 0;

  54.         %hash = ();

  55. 

  56.         for my $k ( @$arr )

  57.         {

  58.             bullcow( $k, $e, $AB );

  59.             $hash{$AB}++;

  60.         } 

  61. 

  62.         #5.243

  63.         grep { $amount += $_ * log($_) } values %hash;

  64.         #$amount /= scalar(keys %hash);

  65. 

  66.         #5.239

  67.         if ( exists $ref->{$e} ) { $amount -= 2*log(2) }

  68. 

  69.         $keymap{$e} = $amount;

  70. 

  71.         #if ($amount < $minval) 26408

  72.         if ($amount < $minval) #26405

  73.         {

  74.         	$minval = $amount;

  75.         	$minkey = $e;

  76.         }

  77.     }

  78. 

  79.     #建立反馈项和缩小集合组

  80.     for my $k ( @$arr )

  81.     {

  82.         #删除 $minkey 以外的项（当前层）

  83.         delete $ref->{$k} if ($k ne $minkey);

  84. 

  85.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集

  86.         bullcow( $minkey, $k, $AB );    

  87.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );

  88.     }

  89.     

  90.     for my $ab ( keys %{ $ref->{ $minkey } } )

  91.     {

  92.         printf " $lv -> $ab, %d\n", $#$arr;

  93.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );

  94.     }

  95. }

  96. 

  97. sub permute

  98. {

  99.     my ( $a, $b, $n, $aref ) = @_;

  100.     my $last = $#$a;

  101. 

  102.     if ( $#$b >= ($n-1) )

  103.     {

  104.         push @$aref, join("", @$b);

  105.         return;

  106.     }

  107. 

  108.     for my $idx ( 0 .. $last )

  109.     {

  110.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );

  111.     }

  112. }

  113. 

  114. __END__

  115. __C__

  116. void bullcow(char *stra, char *strb, char *AB)

  117. {

  118.     int idx;

  119.     char a = '0';

  120.     char b = '0';

  121. 

  122.     for ( idx = 0; idx < 4; idx++ )

  123.     {

  124.         if ( stra[idx] == strb[idx] )

  125.             a++;

  126.         else

  127.             if ( strchr(stra, strb[idx]) != 0 )

  128.             {

  129.                 b++;

  130.             }

  131.     }

  132. 

  133.     AB[0] = a;

  134.     AB[1] = b;

  135. }
复制代码


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