向聴数を求めるプログラム

麻雀の向聴数を求めるプログラムを書いてみた。

向聴数を求めるアルゴリズムについては、以下のページに詳しい説明がある。

向聴数を求めるアルゴリズム - あらの（一人）麻雀研究所

国士無双と七対子は考慮せず、一般の4面子1雀頭の形式に限れば、

向聴数＝ 8 − 面子の数 × 2 − 搭子の数*1

であり、各色(萬子、筒子、索子、字牌)にまたがった面子はないことから、色ごとに面子と搭子の数を数えておいて最後に上の式にあてはめればよいわけだが、面倒な点が2つある。

面子を作れるだけ作るのではなく、意図的に搭子を残すことが必要な場合がある
かといって搭子を残しすぎてはいけない

例えば、の場合、
萬子でとの2面子をとって3向聴と考えがちだが、の1面子だけとって、、、の3搭子を残せは実は2向聴であることが分かる。

ただし似た形だが、

の場合は字牌に対子が2つあるので、萬子からは2面子とるのが正解となる。

これらを考慮して作ったPerlプログラムは以下の通り。

#!/usr/bin/perl -T

use strict;
use warnings;

sub dazi {
    my ($pai) = @_;

    my ($n_pai, $n_dazi);
    for (my $i = 0; $i < 9; $i++) {
        $n_pai += $pai->[$i];
        if ($i < 7 && $pai->[$i+1] == 0 && $pai->[$i+2] == 0) {
            $n_dazi += int($n_pai / 2);
            $n_pai = 0;
        }
    }
    $n_dazi += int($n_pai / 2);
    return $n_dazi;
}

sub mianzi {
    my ($pai, $n) = @_;

    if ($n == 9) {
        my $dazi = dazi($pai);
        return [[0, $dazi], [0, $dazi]]; 
    }

    my $max = mianzi($pai, $n + 1);

    if ($n < 7 && $pai->[$n] > 0 && $pai->[$n+1] > 0 && $pai->[$n+2] > 0) {
        my @pai = @$pai;
        $pai[$n]--; $pai[$n+1]--; $pai[$n+2]--;
        my $r = mianzi(\@pai, $n);
        $r->[0][0]++; $r->[1][0]++;
        $max->[0] = $r->[0]
            if ($r->[0][0]*2 + $r->[0][1] > $max->[0][0]*2 + $max->[0][1]);
        $max->[1] = $r->[1]
            if ($r->[1][0]*10 + $r->[1][1] > $max->[1][0]*10 + $max->[1][1]);
    }
    if ($pai->[$n] >= 3) {
        my @pai = @$pai;
        $pai[$n] -= 3;
        my $r = mianzi(\@pai, $n);
        $r->[0][0]++; $r->[1][0]++;
        $max->[0] = $r->[0]
            if ($r->[0][0]*2 + $r->[0][1] > $max->[0][0]*2 + $max->[0][1]);
        $max->[1] = $r->[1]
            if ($r->[1][0]*10 + $r->[1][1] > $max->[1][0]*10 + $max->[1][1]);
    }
    return $max;
}

sub mianzi_all {
    my ($shoupai) = @_;

    my %mianzi;
    for my $s ('m', 'p', 's') {
        $mianzi{$s} = mianzi($shoupai->{$s}, 0);
    }
    $mianzi{z} = [0, 0];
    $mianzi{z}->[0] += grep { $_ >= 3 } @{$shoupai->{z}};
    $mianzi{z}->[1] += grep { $_ == 2 } @{$shoupai->{z}};
    my $min_xiangting = 8;
    for my $m (@{$mianzi{m}}) {
        for my $p (@{$mianzi{p}}) {
            for my $s (@{$mianzi{s}}) {
                my $z = $mianzi{z};
                my $mianzi = $m->[0] + $p->[0] + $s->[0] + $z->[0];
                my $dazi   = $m->[1] + $p->[1] + $s->[1] + $z->[1];
                $mianzi + $dazi <= 4    or $dazi = 4 - $mianzi;
                my $xiangting = 8 - $mianzi * 2 - $dazi;
                $min_xiangting = $xiangting if ($xiangting < $min_xiangting);
            }
        }
    }
    return $min_xiangting;
}

sub xiangting {
    my ($shoupai) = @_;

    my $min_xiangting = mianzi_all($shoupai);

    for my $s (keys %$shoupai) {
        for (my $i = 0; $i < @{$shoupai->{$s}}; $i++) {
            if ($shoupai->{$s}[$i] > 1) {
                $shoupai->{$s}[$i] -= 2;
                my $xiangting = mianzi_all($shoupai) - 1;
                $shoupai->{$s}[$i] += 2;
                $min_xiangting = $xiangting if ($xiangting < $min_xiangting);
            }
        }
    }
    return $min_xiangting;
}

sub shoupai {
    my ($str) = @_;

    my $shoupai = {
        m => [0,0,0,0,0,0,0,0,0],
        p => [0,0,0,0,0,0,0,0,0],
        s => [0,0,0,0,0,0,0,0,0],
        z => [0,0,0,0,0,0,0]
    };

    for my $sub ($str =~ /\d+[mpsz]/g) {
        $sub =~ s/([mpsz])$//;
        my $sort = $1;
        for my $n ($sub =~ /\d/g) {
            $shoupai->{$sort}[$n-1]++;
        }
    }
    return $shoupai;
}

if (@ARGV) {
    my $xiangting = xiangting(shoupai(@ARGV));
    print "XiangTing: $xiangting\n";
}
else {
    while (<>) {
        my ($paistr) = split;
        my $xiangting = xiangting(shoupai($paistr));
        print "$paistr $xiangting\n";
    }
}

搭子の数え方にひと工夫していて、搭子の組み合わせパターンを数え上げてはいないです。搭子となり得る「距離」にある「搭子グループ」の牌数を2で割っているだけ。

これをJavaScriptに移植して、天鳳の牌理のページをまねたプログラムも作ってみた。

電脳麻将: 牌理

麻雀のアルゴリズムはいろいろ奥が深いので、もうちょっと突っ込んでみることにする。

*1:正確には「面子候補」だが、面倒なので搭子と呼ぶことにする