[Perl版块]猜数字游戏专题

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 369
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 32 times
Been thanked: 36 times
联系:

[Perl版块]猜数字游戏专题

帖子 #1 523066680 » 2017年08月10日 21:59


头像
523066680
Administrator
Administrator
帖子: 369
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 32 times
Been thanked: 36 times
联系:

Re: [Perl版块]猜数字游戏专题

帖子 #2 523066680 » 2018年11月09日 17:42

生成搜索树

  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_avg.perl.txt", Dumper $tree);
  32. write_file("./Tree_avg.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.     for my $e ( @$orders )
  50.     {
  51.         $amount = 0;
  52.         %hash = ();
  53.  
  54.         for my $k ( @$arr )
  55.         {
  56.             bullcow( $k, $e, $AB );
  57.             $hash{$AB}++;
  58.             $hash{$k} = "$AB";
  59.         }
  60.  
  61.         for my $k ( @$arr )
  62.         {
  63.             $amount += $hash{ $hash{$k} };
  64.         }
  65.        
  66.         $keymap{$e} = $amount;
  67.  
  68.         if ($amount < $minval)
  69.         {
  70.             $minval = $amount;
  71.             $minkey = $e;
  72.         }
  73.     }
  74.  
  75.     #print "$minval $minkey\n";
  76.  
  77.     #如果筛选集中有符合条件的项,优先选择
  78.     for my $k ( @$arr )
  79.     {
  80.         if ( $keymap{$k} == $minval ) { $minkey = $k; last; }
  81.     }
  82.  
  83.     #建立反馈项和缩小集合组
  84.     for my $k ( @$arr )
  85.     {
  86.         #删除 $minkey 以外的项(当前层)
  87.         delete $ref->{$k} if ($k ne $minkey);
  88.  
  89.         #创建反馈项以及对应子集 / 反馈为 40 的项无需子集
  90.         bullcow( $minkey, $k, $AB );    
  91.         $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );
  92.     }
  93.    
  94.     for my $ab ( keys %{ $ref->{ $minkey } } )
  95.     {
  96.         printf " $lv -> $ab, %d\n", $#$arr;
  97.         maketree( $ref->{$minkey}{$ab},  [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );
  98.     }
  99. }
  100.  
  101. sub permute
  102. {
  103.     my ( $a, $b, $n, $aref ) = @_;
  104.     my $last = $#$a;
  105.  
  106.     if ( $#$b >= ($n-1) )
  107.     {
  108.         push @$aref, join("", @$b);
  109.         return;
  110.     }
  111.  
  112.     for my $idx ( 0 .. $last )
  113.     {
  114.         permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
  115.     }
  116. }
  117.  
  118. __END__
  119. __C__
  120. void bullcow(char *stra, char *strb, char *AB)
  121. {
  122.     int idx;
  123.     char a = '0';
  124.     char b = '0';
  125.  
  126.     for ( idx = 0; idx < 4; idx++ )
  127.     {
  128.         if ( stra[idx] == strb[idx] )
  129.             a++;
  130.         else
  131.             if ( strchr(stra, strb[idx]) != 0 )
  132.             {
  133.                 b++;
  134.             }
  135.     }
  136.  
  137.     AB[0] = a;
  138.     AB[1] = b;
  139. }


回到 “Perl”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客