游戏说明 - [专区-算法与编码]猜数字游戏 - 专题
参考:
[Perl版块]猜数字游戏专题
- 523066680
- Administrator
- 帖子: 492
- 注册时间: 2016年07月19日 12:14
- 拥有现金: 锁定
- 储蓄: 锁定
- Has thanked: 58 times
- Been thanked: 96 times
- 联系:
Re: [Perl版块]猜数字游戏专题
生成搜索树
- =info
- 生成最大反馈指标搜索树
- Code-by : 523066680
- Date : 2017-08
- =cut
- use List::Util qw/max sum/;
- use JSON;
- use Inline C;
- use IO::Handle;
- use Data::Dumper;
- use File::Slurp;
- use Time::HiRes qw/sleep/;
- STDOUT->autoflush(1);
- $Data::Dumper::Indent = 1;
- #生成排列
- our @orders;
- permute( [0 .. 9] , [], 4, \@orders);
- #生成树
- print "Make tree\n";
- my $tree;
- $tree = { "0123" => {} };
- maketree( $tree, \@orders, 0 );
- #导出
- print "Dump tree\n";
- write_file("./Tree_avg.perl.txt", Dumper $tree);
- write_file("./Tree_avg.json.txt", encode_json($tree) );
- sub maketree
- {
- our @orders;
- my $orders;
- my ($ref, $arr, $lv) = @_;
- my $AB = "00";
- my %keymap;
- my %hash;
- my $minkey;
- my $minval = 10000000;
- my $amount;
- if ($lv == 0) { $orders = ["0123"] }
- else { $orders = \@orders }
- for my $e ( @$orders )
- {
- $amount = 0;
- %hash = ();
- for my $k ( @$arr )
- {
- bullcow( $k, $e, $AB );
- $hash{$AB}++;
- $hash{$k} = "$AB";
- }
- for my $k ( @$arr )
- {
- $amount += $hash{ $hash{$k} };
- }
- $keymap{$e} = $amount;
- if ($amount < $minval)
- {
- $minval = $amount;
- $minkey = $e;
- }
- }
- #print "$minval $minkey\n";
- #如果筛选集中有符合条件的项,优先选择
- for my $k ( @$arr )
- {
- if ( $keymap{$k} == $minval ) { $minkey = $k; last; }
- }
- #建立反馈项和缩小集合组
- for my $k ( @$arr )
- {
- #删除 $minkey 以外的项(当前层)
- delete $ref->{$k} if ($k ne $minkey);
- #创建反馈项以及对应子集 / 反馈为 40 的项无需子集
- bullcow( $minkey, $k, $AB );
- $ref->{$minkey}{$AB}{$k} = {} if ( $AB ne "40" );
- }
- for my $ab ( keys %{ $ref->{ $minkey } } )
- {
- printf " $lv -> $ab, %d\n", $#$arr;
- maketree( $ref->{$minkey}{$ab}, [ sort keys %{$ref->{$minkey}{$ab}} ], $lv+1 );
- }
- }
- sub permute
- {
- my ( $a, $b, $n, $aref ) = @_;
- my $last = $#$a;
- if ( $#$b >= ($n-1) )
- {
- push @$aref, join("", @$b);
- return;
- }
- for my $idx ( 0 .. $last )
- {
- permute( [ @$a[0 .. $idx-1, $idx+1 .. $last] ], [ @$b, $a->[$idx] ], $n, $aref );
- }
- }
- __END__
- __C__
- void bullcow(char *stra, char *strb, char *AB)
- {
- int idx;
- char a = '0';
- char b = '0';
- for ( idx = 0; idx < 4; idx++ )
- {
- if ( stra[idx] == strb[idx] )
- a++;
- else
- if ( strchr(stra, strb[idx]) != 0 )
- {
- b++;
- }
- }
- AB[0] = a;
- AB[1] = b;
- }
- rubyish
- 渐入佳境
- 帖子: 38
- 注册时间: 2018年04月23日 09:58
- 拥有现金: 锁定
- Has thanked: 18 times
- Been thanked: 14 times
- 联系:
Re: [Perl版块]猜数字游戏专题
v2:
sample:


sample:
ANS = 0493
0123 20
0145 11
0426 20
0473 30
0483 30
0493 40
COUNT = 6
----------
ANS = 0495
0123 10
0456 21
0467 20
0485 30
0495 40
COUNT = 5
----------
ANS = 0496
0123 10
0456 30
0457 20
0486 30
0496 40
COUNT = 5
----------
#!/usr/bin/perl -w
# version 28, subversion 0 (v5.28.0)
# 2018-11-14
use 5.028;
my @all = map [ split // ], grep !/(.).*\1/, "0123" .. "9876";
my $tree = make( \@all );
TEST();
# ____________________SUB____________________
sub TEST {
for my $ans (@all) {
guess($ans);
}
}
sub GUESS() { 0 }
sub AB() { 1 }
sub guess {
my $ans = shift;
my $count = 0;
my $pos = 0;
$pos |= ( 1 << $_ ) for @$ans;
my $next = $tree;
say "ANS = ", join '', @$ans;
while ($next) {
my $guess = $next->[GUESS];
my @guess = split //, $guess;
my $A = 0;
my $B = 0;
for my $i ( 0 .. 3 ) {
$guess[$i] == $ans->[$i] ? $A++
: ( $pos & ( 1 << $guess[$i] ) ) ? $B++
: undef;
}
$next = $next->[AB]{ $A . $B };
$count++;
say $guess, "\t", $A . $B;
}
say "COUNT =\t$count";
say "----------\n";
}
sub make {
my $all = shift;
my $tree = [];
M_( $tree, $all );
return $tree;
}
sub M_ {
my ( $tree, $all ) = @_;
my $guess = $all->[0];
$tree->[GUESS] = join '', @$guess;
my $pos = 0;
$pos |= ( 1 << $_ ) for @$guess;
for my $i ( 1 .. $#$all ) {
my $num = $all->[$i];
my $A = 0;
my $B = 0;
for my $j ( 0 .. 3 ) {
$guess->[$j] == $num->[$j] ? $A++
: ( $pos & ( 1 << $num->[$j] ) ) ? $B++
: undef;
}
push @{ $tree->[AB]{ $A . $B } }, $num;
}
while ( my ( $ab, $maybe ) = each %{ $tree->[AB] } ) {
$tree->[AB]{$ab} = [];
M_( $tree->[AB]{$ab}, $maybe );
}
}
__DATA__
$_
$_
- rubyish
- 渐入佳境
- 帖子: 38
- 注册时间: 2018年04月23日 09:58
- 拥有现金: 锁定
- Has thanked: 18 times
- Been thanked: 14 times
- 联系:
Re: [Perl版块]猜数字游戏专题
v3:
real 0m0.640s
sample:
time perl abc.pl



real 0m0.640s
sample:
1 1
2 13
3 108
4 596
5 1668
6 1768
7 752
8 129
9 5
AVE = 5.56031746031746
real 0m0.640s
user 0m0.626s
sys 0m0.012s
time perl abc.pl
#!/usr/bin/perl -w
# version 28, subversion 0 (v5.28.0)
# 2018-11-14, 2018-11-17
use 5.028;
my @INDES = ( 0, 5, 9, 12, 13 );
my @all = map [ split // ], grep !/(.).*\1/, "0123" .. "9876";
my $tree = make( \@all );
TEST();
# ____________________SUB____________________
sub TEST {
my @record;
for my $ans (@all) {
#say "ANS = ", @$ans;
my $count = guess($ans);
#say "COUNT =\t$count";
#say "----------\n";
$record[$count]++;
}
my $ave = 0;
for my $i ( 1 .. $#record ) {
say "$i $record[$i]";
$ave += $i * $record[$i];
}
say "AVE = ", $ave / @all;
}
sub GUESS() { 0 }
sub AB() { 1 }
sub guess {
my $ans = shift;
my $count = 0;
my $pos =
( 1 << $ans->[0] ) |
( 1 << $ans->[1] ) |
( 1 << $ans->[2] ) |
( 1 << $ans->[3] );
my $next = $tree;
while ($next) {
my $guess = $next->[GUESS];
my $A = 0;
my $B = 0;
for my $i ( 0 .. 3 ) {
$guess->[$i] == $ans->[$i] ? $A++
: ( $pos & ( 1 << $guess->[$i] ) ) ? $B++
: undef;
}
$next = $next->[AB][ $INDES[$A] + $B ];
$count++;
#say @$guess, "\t", $A . $B;
}
return $count;
}
sub make {
my $all = shift;
my $tree = [];
M_( $tree, $all );
return $tree;
}
sub M_ {
my ( $tree, $all ) = @_;
my $guess = $all->[0];
$tree->[GUESS] = $guess;
my $pos =
( 1 << $guess->[0] ) |
( 1 << $guess->[1] ) |
( 1 << $guess->[2] ) |
( 1 << $guess->[3] );
for my $i ( 1 .. $#$all ) {
my $num = $all->[$i];
my $A = 0;
my $B = 0;
for my $j ( 0 .. 3 ) {
$guess->[$j] == $num->[$j] ? $A++
: ( $pos & ( 1 << $num->[$j] ) ) ? $B++
: undef;
}
push @{ $tree->[AB][ $INDES[$A] + $B ] }, $num;
}
for my $i ( 0 .. $#{ $tree->[AB] } ) {
my $maybe = $tree->[AB][$i] // next;
$tree->[AB][$i] = [];
M_( $tree->[AB][$i], $maybe );
}
}
__DATA__
$_
$_
在线用户
用户浏览此论坛: 没有注册用户 和 0 访客