DouKaku?

解答・コメントを送る方法

コメントを送るには2つの方法があります。

匿名でコメントを書く
ログインせずにコメントを書くことができます。名前は「匿名」となります。
アカウントを作成してコメントを書く
アカウントを作成すると、記名での投稿ができます。また、プロフィールページが作成され、簡単なプロフィールや統計情報が表示されるようになります。

どちらの場合も投稿後の修正・削除はできないので、投稿前によくご確認下さい。

投稿ボタンを押す前に以下の文章を確認してください

当サイトへの投稿はクリエイティブ・コモンズ・ライセンス BY(表示)および、その解釈に同意するものとみなされます。各ページには下のようにライセンス表示が行われます。
このサイトの内容は、クリエイティブ・コモンズ・ライセンスの下でライセンスされています。 [詳細]
あなたの投稿したコード・コメント・トピックが再利用・添削されることを望まない場合は、投稿をお控えください。
自分が書いていない、ウェブサイトや書籍などからの無断コピーは著作権の侵害です。著作権者の了解を得るか、自分で0から書いてください。
著作権の侵害、名誉毀損、など投稿内容に問題がある場合、削除することがあります。
これらのことにあなたはあらかじめ同意したものとみなされます。

Post comment

Post a comment to the following challenge: マルバツゲーム：賢いプレイヤー (Nested Flatten)

As a reply to the following comment: 匿名: 4つの戦略(どのように石を置くか)を作り...(#7570) [show]

[hide]

4つの戦略(どのように石を置くか)を作りました：
  1. put_stone_random ... ランダムに置く。
  2. ps_prevent_losing ... リーチをかけられてるなら、防ぐ。さもなくば1.の戦略をとる。
  3. ps_grasp_chance ...リーチをかけてるなら、そこにおいてゲームに勝つ。さもなくば2.の戦略をとる。
  4. ps_smart ...
    リーチをかけてるなら、そこにおいてゲームに勝つ。
    リーチをかけられてるなら、防ぐ。
    さもなくば、可能な限り、ダブルリーチを仕掛けに行く。

ps_smart を書くために、マルバツゲームを手で解きました。
各盤面に対する最善手を %ptn_pos_h に押し込めました。
蛇足：%ptn_pos_h を調整することで、 ps_smart の強さを調整できます。

実行結果： perl marubatsu.pl
***** ps_smart vs put_stone_random *****
game 1..10000
D=>115 o=>9885 
***** put_stone_random vs ps_smart *****
game 10001..20000
D=>2373 x=>7627 
***** ps_smart vs ps_smart *****
game 20001..20100
D=>100

$board = [map {[map {'-'} 0..2]} 0..2];

sub game {
    clear($board);
    game_loop(@_);
}
sub game_loop {
    my ($player1, $player2) = @_;
    my $w;
    $player1->{put_stone}($player1->{stone});
    if ($w=check($board)) { return $w; }
    game_loop($player2,$player1);
}

sub put_stone_random {
    my $stone = shift;
    while (1) {
    my($r,$c) = (int rand @$board, int rand @$board);
    if (0<=$r and $r<@$board and
        0<=$c and $c<@$board and
        $board->[$r][$c] eq '-') {
        $board->[$r][$c] = $stone;
        last;
    }
    }
}
sub ps_prevent_losing { # ps :abbrev: put_stone
    my $stone = shift;
    my($r,$c) = pos_oppreach($board,$stone);
    if (defined($r) and defined($c)) {
    $board->[$r][$c] = $stone;
    } else {
    put_stone_random($stone);
    }
}
sub ps_grasp_chance {
    my $stone = shift;
    my($r,$c) = pos_oppreach($board,oppstone($stone));
    if (defined($r) and defined($c)) {
    $board->[$r][$c] = $stone;
    } else {
    ps_prevent_losing($stone);
    }
}
sub ps_smart {
    my $stone = shift;
    # ps_grasp_chance
    my($r,$c) = pos_oppreach($board,oppstone($stone));
    if (defined($r) and defined($c)) {
    $board->[$r][$c] = $stone;
    return;
    }
    # ps_prevent_losing
    ($r,$c) = pos_oppreach($board,$stone);
    if (defined($r) and defined($c)) {
    ps_prevent_losing($stone);
    return;
    }
    # attack dreach # dreach :abbrev: double reach
    ($r,$c) = pos_smart($board,$stone);
    if (defined($r) and defined($c)) {
    $board->[$r][$c] = $stone;
    return;
    }
    put_stone_random($stone);
}

sub pos_oppreach {
    my($board,$stone) = @_;
    my($r,$c);
    ($r,$c) = pos_oppreach_row($board,$stone);
    if (defined($r) and defined($c)) { return ($r,$c); }
    ($r,$c) = pos_oppreach_column($board,$stone);
    if (defined($r) and defined($c)) { return ($r,$c); }
    ($r,$c) = pos_oppreach_crossline($board,$stone);
    if (defined($r) and defined($c)) { return ($r,$c); }
    (undef, undef)
}
sub pos_oppreach_row {
    my($board,$stone) = @_;
    my @board_strs = join0s($board);
    for (0..(@$board-1)) {
    my $i = index_oppreach($board_strs[$_], $stone);
    if (defined($i)) {
        return ($_, $i);
    }
    }
    (undef, undef);
}
sub pos_oppreach_column {
    my($board,$stone) = @_;
    my @board_strs = ($board->[0][0].$board->[1][0].$board->[2][0],
              $board->[0][1].$board->[1][1].$board->[2][1],
              $board->[0][2].$board->[1][2].$board->[2][2]);
    for (0..(@$board-1)) {
    my $i = index_oppreach($board_strs[$_], $stone);
    if (defined($i)) {
        return ($i, $_);
    }
    }
    (undef, undef);
}
sub pos_oppreach_crossline {
    my($board,$stone) = @_;
    my @board_strs = get_crosslines($board);
    my $i = index_oppreach($board_strs[0], $stone);
    if (defined($i)) {
    return ($i,$i);
    }
    $i = index_oppreach($board_strs[1], $stone);
    if (defined($i)) {
    return (@$board-1-$i,$i);
    }
    (undef, undef);
}
sub index_oppreach { # test: index_oppreach('o-o', 'x') == 1
    my $s = $_[0];
    my $o = oppstone($_[1]);
    if ($o eq 'o') {
        if ($s eq '-oo') { return 0; }
        if ($s eq 'o-o') { return 1; }
        if ($s eq 'oo-') { return 2; }
    } else { # $o eq 'o'
        if ($s eq '-xx') { return 0; }
        if ($s eq 'x-x') { return 1; }
        if ($s eq 'xx-') { return 2; }
    }
    undef;
}
sub oppstone {
    $_[0] eq 'o' ? 'x' : $_[0] eq 'x' ? 'o' : undef;
}

my %ptn_pos_h;
{
    my $ptn_pos_href = {
    # play first
    '--- --- ---' => [0,0],
    'ox- --- ---' => [1,1], # [2,0] is also ok : [2,0] [1,0] [2,2]
    'ox- -o- --x' => [1,0], # dreach
    'o-x --- ---' => [2,0],
    'o-x x-- o--' => [2,2], # dreach
    'o-- --x ---' => [2,0], # dreach by gc
    'o-- --- --x' => [2,0],
    'o-- x-- o-x' => [0,2], # dreach ... same as 'o-x x-- o--'
    'o-- -x- ---' => [2,2],
    'o-x -x- --o' => [2,0], # dreach
    
       # play second / first ps pos == (0 0)
    'o-- --- ---' => [1,1],
    'o-- -x- --o' => [2,1], # draw by gc
    'o-- -x- -o-' => [2,2], # dreach by gc 1/5 , draw by gc 4/5
       # play second / first ps pos == (1 1)    
    '--- -o- ---' => [0,0],
    'x-- -o- --o' => [0,2], # draw by gc
       # play second / first ps pos == (0 1)
    '-o- --- ---' => [0,0],
    'xoo --- ---' => [2,0],
    'xoo o-- x--' => [2,2], # dreach
    'xo- --o ---' => [2,0], # dreach by gc
    
    'xo- --- o--' => [1,1], # draw by gc
    
    'xo- o-- ---' => [2,1],
    'xoo o-- -x-' => [2,2], # dreach
    'xo- o-- ox-' => [0,2], # draw by gc
    'xo- o-- -xo' => [0,2], # draw by gc
    
    'xo- --- --o' => [1,1], # dreach by gc 1/5 , draw by gc 4/5
    };
    %ptn_pos_h = %$ptn_pos_href;
}
sub pos_smart { # assume: play first => 'o', play second => 'x', marubatsuptn
    my($board,$stone) = @_;
    for my $m (0..1) { # means: nflip
    for my $n (0..3) { # means: nrot
        my $ptn = match_board(brott($n,bflipt($m,$board)));
        if (defined $ptn) {
        #print "$ptn => @{$ptn_pos_h{$ptn}} : $m $n : debugwrite";
        return to_a(pflipt($m,prott(-$n,$ptn_pos_h{$ptn})));
        }
    }
    }
    (undef, undef);
}
sub brott {
    my($n, $board) = @_;
    dotimes($n % 4, $board, \&brot);
}
sub bflipt {
    my($n, $board) = @_;
    dotimes($n % 2, $board, \&bflip);
}
sub pflipt {
    my($n, $pos) = @_;
    dotimes($n % 2, $pos, \&pflip);
}
sub prott {
    my($n, $pos) = @_;
    dotimes($n % 4, $pos, \&prot);
}
sub dotimes {
    my($n, $obj, $coderef) = @_;
    $n==0 ? $obj : dotimes($n-1, $coderef->($obj), $coderef);
}
sub brot {
    trans(bflip($_[0]));
}
sub bflip {
    [map {[reverse @$_];} @{$_[0]}];
}
sub pflip {
    my @b = @{$_[0]};
    $b[1] = 2 - $b[1]; # pos flip
    \@b;
}
sub prot {
    my @b = @{$_[0]};
    $b[0]-=1; $b[1]-=1;
    my @c = (-$b[1], $b[0]); # pos rot ... 90 degree
    $c[0]+=1; $c[1]+=1;
    \@c;
}
sub match_board {
  my $board_str = join(' ', join0s(shift));
  my @mp = grep { $board_str eq $_; } keys %ptn_pos_h;
  (scalar @mp) ? $mp[0] : undef;
}
sub to_a {
    @{$_[0]};
}

sub check {
    my @b = @{$_[0]};
    my $w;
    # check rows
    for my $r (0..2) {
    my $l = $b[$r]->[0]; # abbrev: left of board
    if ($l ne'-' and $l eq$b[$r]->[1] and $l eq$b[$r]->[2]) { return $l; }
    }
    # check columns
    for my $c (0..2) {
    my $t = $b[0]->[$c]; # abbrev: top of board
    if ($t ne'-' and $t eq$b[1]->[$c] and $t eq$b[2]->[$c]) { return $t; }
    }
    # check crosslines
    my $p = $b[0]->[0]; # abbrev: pos
    if ($p ne'-' and $p eq$b[1]->[1] and $p eq$b[2]->[2]) { return $p; }
    $p = $b[2]->[0];
    if ($p ne'-' and $p eq$b[1]->[1] and $p eq$b[0]->[2]) { return $p; }
    # check draw
    if (filledp(\@b)) { return 'D'; } # means: draw
    undef;
}

sub join0s {
    my @b = @{$_[0]};
    my @a;
    $a[0] = join '', @{$b[0]};
    $a[1] = join '', @{$b[1]};
    $a[2] = join '', @{$b[2]};
    @a;
    # map {join '', @$_} @{$_[0]};
}
sub trans {
    my $m = shift;
    my $n = [];
    for my $r (0..2) {
    for my $c (0..2) {
        $n->[$c][$r] = $m->[$r][$c];
    }
    }
    $n;
}
sub get_crosslines {
    my $b = shift;
    join0s [[map {$b->[      $_][$_]} 0..(@$b-1)],
        [map {$b->[@$b-1-$_][$_]} 0..(@$b-1)]];
}
sub filledp {
    my $b = shift;
    for my $r (0..(@$b-1)) {
    for my $c (0..(@{$b->[$r]}-1)) {
        if ($b->[$r][$c] eq '-') { return 0; }
    }
    }
    1;
}

# utilities
sub clear {
    my $b = shift;
    for my $r (0..(@$b-1)) {
    for my $c (0..(@{$b->[$r]}-1)) {
        $b->[$r][$c] = '-';
    }
    }
}

################### run game ###################

$gc = 0; # abbrev: game count

sub game_times {
    my($player1,$player2,$ngame) = @_;
    my %wc;
    print "***** $player1 vs $player2 *****\n";
    print "game ", $gc+1, "..", $gc+$ngame, "\n";
    $gc += $ngame;
    for (1..$ngame) {
    my $w = game({put_stone=>\&$player1, stone=>'o'},
             {put_stone=>\&$player2, stone=>'x'});
    $wc{$w}++;
    }
    while (my($k,$v) = each(%wc)) {
    print "$k=>$v ";
    }
    print "\n";    
}

$ngame = 10000;
game_times('ps_smart', 'put_stone_random', $ngame);
game_times('put_stone_random', 'ps_smart', $ngame);
game_times('ps_smart', 'ps_smart', 100);

コメント本文	形式 [?] 無加工(text) 整形済み(pre) オリジナル記法(original) Markdown ReStructured Text はてな記法
コード	言語タグ半角スペースで区切って複数のタグを入力できます。参考ページタイトル参考ページURL
利用規約に同意します利用規約を読んで同意する必要があります。
by guest

DouKaku?

解答・コメントを送る方法

投稿ボタンを押す前に以下の文章を確認してください

Post comment

Index

Feed

Other

Link

Pathtraq