前の記事 を書き終わった瞬間、通常の麻雀の天和の確率もそれほど面倒くさくないと思えた。しかしデバッグしながらプログラムを書いたら、それでも半日かかった。
最初の6時間で書いたプログラムでは、およそ2千万回に一度という数字が出た。ここで定説を調べる。33万回に一回と言われているようだ。む、おかしい。別の数字が出るのは期待していたが、定説より頻繁に出るという予想をしていたのに。 ……清一以外の面子手は、3面子1雀頭で牌姿を出すという大ポカをしていた。道理で両盃口チェックがほとんど必要なかったわけだ。
ほとんど作り直して、やはり5時間経過。
牌姿は1412万6636 通り。大雑把に24万回に一回という答が出た。母数が4.25×10の18乗、和了形はそのうち1.74×10の13乗。
(七対子・国士を考慮に入れないときの牌姿は875万4027通り、出現率はだいたい27万回に一回だ)
このプログラムは私の貧弱な環境でも2秒足らずで計算ができた。
#!/usr/bin/env perl # # OneColor.pm 2011-09-10 yaemon # package MahjongCalc::OneColor; use strict; use warnings; use Carp; use Exporter; use vars qw( @ISA @EXPORT_OK ); @ISA = qw( Exporter); @EXPORT_OK = qw( pairs paishi cases );
# 面子の数 , 雀頭の有無をもらい数を返す外部インタフェイス sub pairs( $$ ); sub paishi( $$ ); sub cases( $$ );
sub _init; # 牌姿の配列から計算した値を返す内部関数 sub _cases( @ );
# 牌姿を作成する内部関数 sub _calc( $$ ); sub addMentz( $ ); sub addHead( $ ); sub pai2str( $ ); sub merge( $$ );
# static な変数 my $cache; my @mentz; my @head;
sub new() { my $self = bless {} , shift; return $self; }
sub _init() { if ( exists( $cache->{ 'init' } ) ) { return; } $cache->{ 'init' }=1; push @mentz , [ 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 3 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 3 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 3 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 3 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 0 , 3 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 ]; push @mentz , [ 1 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 1 , 1 , 1 , 0 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 1 , 1 , 1 , 0 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 1 , 1 , 1 , 0 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 1 , 1 , 1 , 0 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 1 , 1 , 1 , 0 ]; push @mentz , [ 0 , 0 , 0 , 0 , 0 , 0 , 1 , 1 , 1 ];
push @head , [ 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @head , [ 0 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @head , [ 0 , 0 , 2 , 0 , 0 , 0 , 0 , 0 , 0 ]; push @head , [ 0 , 0 , 0 , 2 , 0 , 0 , 0 , 0 , 0 ]; push @head , [ 0 , 0 , 0 , 0 , 2 , 0 , 0 , 0 , 0 ]; push @head , [ 0 , 0 , 0 , 0 , 0 , 2 , 0 , 0 , 0 ]; push @head , [ 0 , 0 , 0 , 0 , 0 , 0 , 2 , 0 , 0 ]; push @head , [ 0 , 0 , 0 , 0 , 0 , 0 , 0 , 2 , 0 ]; push @head , [ 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 2 ]; return; }
sub pairs( $$ ) { if ( ! exists( $cache->{ 'init' } ) ) { _init(); } my $MentzNum = shift; my $WantHead = shift;
if ( ! exists( $cache->{ $MentzNum }->{ $WantHead } ) ) { _calc ( $MentzNum , $WantHead ); } return $cache->{ $MentzNum }->{ $WantHead }->{ 'pairs' }; }
sub paishi( $$ ) { if ( ! exists( $cache->{ 'init' } ) ) { _init(); } my $MentzNum = shift; my $WantHead = shift;
if ( ! exists( $cache->{ $MentzNum }->{ $WantHead } ) ) { _calc ( $MentzNum , $WantHead ); } return $cache->{ $MentzNum }->{ $WantHead }->{ 'paishi' }; }
sub cases( $$ ) { if ( ! exists( $cache->{ 'init' } ) ) { _init(); } my $MentzNum = shift; my $WantHead = shift;
if ( ! exists( $cache->{ $MentzNum }->{ $WantHead } ) ) { _calc ( $MentzNum , $WantHead ); } return $cache->{ $MentzNum }->{ $WantHead }->{ 'cases' }; }
sub _calc( $$ ) { my $wantMentz = shift; my $wantHead = shift; if ( exists( $cache->{ $wantMentz }->{ $wantHead } ) ) { return; }
my $paiHash = getPaishi( $wantMentz , $wantHead );
if ( $wantMentz % 2 ) { $cache->{ $wantMentz }->{ $wantHead }->{ 'pairs' } = 0; } else { $cache->{ $wantMentz }->{ $wantHead }->{ 'pairs' } = scalar( grep( /^[02]+$/ , keys( %$paiHash ) ) ); } $cache->{ $wantMentz }->{ $wantHead }->{ 'paishi'} = scalar( keys( %$paiHash ) ); $cache->{ $wantMentz }->{ $wantHead }->{ 'cases' } = _cases( values( %$paiHash )); return; }
sub getPaishi( $$ ) { my $wantMentz = shift; my $wantHead = shift; my %answer = ( "000000000" => [ 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ] ); for ( ; $wantMentz > 0 ; $wantMentz-- ) { %answer = addMentz( \%answer ); } if ( $wantHead ) { %answer = addHead( \%answer ); }
return ( \%answer ); }
sub _cases( @ ) { my $ret = 0; foreach my $paishi ( @_ ) { my $this = 1; foreach my $num ( @$paishi ) { if( $num == 4 || $num == 0 ) { next; } elsif ( $num == 1 || $num == 3 ) { $this *= 4; } elsif ( $num == 2 ) { $this *= 6; } else { die( "num = $num" ); } } $ret += $this; } return $ret; }
sub addMentz( $ ) { my $src = shift; my %ret;
foreach my $paishi ( values( %$src ) ) { for ( my $i = 0 ; $i < @mentz ; $i++ ) { my $new = merge( $paishi , $mentz[ $i ] ); if ( $new ) { my $str = pai2str( $new ); if( ! exists( $ret{ $str } ) ) { $ret{ $str } = $new; } } } } return %ret; }
sub addHead( $ ) { my $src = shift; my %ret;
foreach my $paishi ( values( %$src ) ) { for ( my $i = 0 ; $i < @head; $i++ ) { my $new = merge( $paishi , $head[ $i ] ); if ( $new ) { my $str = pai2str( $new ); if( ! exists( $ret{ $str } ) ) { $ret{ $str } = $new; } } } } return %ret; }
sub pai2str( $ ) { my $src = shift; my $ret = ""; for ( my $i = 0 ; $i < @$src ; $i++ ) { $ret .= $$src[$i]; } return $ret; }
sub merge( $$ ) { my $a = shift; my $b = shift; my @ret; for( my $i = 0 ; $i < 9 ; $i++ ) { my $tmp = $$a[$i] + $$b[$i]; if ( $tmp > 4 ) { return undef; } $ret[$i] = $tmp; } return \@ret; } 1;
#!/usr/bin/env perl # # Tenho.pl 2011-09-10 yaemon # use strict; use warnings; use bignum;
use lib( "../lib" ); use MahjongCalc::OneColor qw( pairs paishi cases);
# 和了形一覧 # 4面子 1雀頭 # 清一 # 一色で4面子 , 残り25種のどこかで雀頭 # 一色で3面子1雀頭 , 別の一色で1面子 # 一色で3面子1雀頭 , 字牌が1刻子 # 一色で3面子 , 別の一色で1面子1雀頭 # 一色で3面子 , 別の一色で1面子, 残り16種のどこかで雀頭 # 一色で3面子 , 字牌で刻子1,雀頭1 # 一色で2面子1雀頭 , 別の一色で2面子 # 一色で2面子1雀頭 , 別の二色で各1面子 # 一色で2面子1雀頭 , 別の一色で1面子 , 字牌刻子1 # 一色で2面子1雀頭 , 字牌刻子2 # 一色で2面子 , 別の一色で2面子, 残り16種のどこかで雀頭 # 一色で2面子 , 別の一色で1面子1雀頭, みっつめの色で1順子 # 一色で2面子 , 別の一色で1面子1雀頭, 残り16種のどこかに1刻子 # 一色で1面子1雀頭 , 別の二色で1面子ずつ , 字牌刻子 # 一色で1面子1雀頭 , 別の一色で1面子 , 字牌2刻子 # 一色で1面子1雀頭 , 字牌時3刻子 # 三色で1面子ずつ , 字牌で雀頭 # 二色で1面子ずつ , 字牌2刻子1対子 # 一色で1面子 , 字牌3刻子1対子 # 字一色 # 上記を出す過程で、二盃口形の数を数える
# 七対子の牌姿をすべて数えて、二盃形の数を引く # 国士無双
#############################################################
my $RyanPeiko = 0; my $Paishi = 0; my $Cases = 0;
# 清一 $RyanPeiko += MahjongCalc::OneColor::pairs( 4 , 1 ) * 3; $Paishi += MahjongCalc::OneColor::paishi( 4 , 1 ) * 3; $Cases += MahjongCalc::OneColor::cases( 4 , 1 ) * 3;
# 一色で4面子 , 残り25種のどこかで雀頭 $RyanPeiko += MahjongCalc::OneColor::pairs( 4 , 0 ) * 3 * 25 ; $Paishi += MahjongCalc::OneColor::paishi( 4 , 0 ) * 3 * 25; $Cases += MahjongCalc::OneColor::cases( 4 , 0 ) * 3 * ( 25 * 6) ;
# 一色で3面子1雀頭 , 別の一色で1面子 $Paishi += MahjongCalc::OneColor::paishi( 3 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * 2; $Cases += MahjongCalc::OneColor::cases( 3 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 1 ) * 2;
# 一色で3面子1雀頭 , 字牌が1刻子 $RyanPeiko += MahjongCalc::OneColor::pairs( 3 , 1 ) * 3 * 7; $Paishi += MahjongCalc::OneColor::paishi( 3 , 1 ) * 3 * 7; $Cases += MahjongCalc::OneColor::cases( 3 , 1 ) * 3 * ( 7 * 4);
# 一色で3面子 , 別の一色で1面子1雀頭 $Paishi += MahjongCalc::OneColor::paishi( 3 , 0 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 1 ) * 2; $Cases += MahjongCalc::OneColor::cases( 3 , 0 ) * 3 * MahjongCalc::OneColor::cases( 1 , 1 ) * 2;
# 一色で3面子 , 別の一色で1面子, 残り16種のどこかで雀頭 $Paishi += MahjongCalc::OneColor::paishi( 3 , 0 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * 2 * 16; $Cases += MahjongCalc::OneColor::cases( 3 , 0 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * 2 * 16 * 6;
# 一色で3面子 , 字牌で刻子1,雀頭1 $Paishi += MahjongCalc::OneColor::paishi( 3 , 0 ) * 3 * ( 7 * 6 ); $Cases += MahjongCalc::OneColor::cases( 3 , 0 ) * 3 * ( 7 * 4 ) * ( 6 * 6 );
# 一色で2面子1雀頭 , 別の一色で2面子 $RyanPeiko += MahjongCalc::OneColor::pairs( 2 , 1 ) * 3 * MahjongCalc::OneColor::pairs( 2 , 0 ) * 2; $Paishi += MahjongCalc::OneColor::paishi( 2 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 2 , 0 ) * 2; $Cases += MahjongCalc::OneColor::cases( 2 , 1 ) * 3 * MahjongCalc::OneColor::cases( 2 , 0 ) * 2;
# 一色で2面子1雀頭 , 別の二色で各1面子 $Paishi += MahjongCalc::OneColor::paishi( 2 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * MahjongCalc::OneColor::paishi( 1 , 0 ) ; $Cases += MahjongCalc::OneColor::cases( 2 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * MahjongCalc::OneColor::cases( 1 , 0 ) ;
# 一色で2面子1雀頭 , 別の一色で1面子 , 字牌刻子1 $Paishi += MahjongCalc::OneColor::paishi( 2 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * 2 * 7; $Cases += MahjongCalc::OneColor::cases( 2 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * 2 * 7 * 6;
# 一色で2面子1雀頭 , 字牌刻子2 $Paishi += MahjongCalc::OneColor::paishi( 2 , 1 ) * 3 * ( 7 * 6 / 2 ); $Cases += MahjongCalc::OneColor::cases( 2 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * 2 * ( 7 * 6 / 2 ) * 4 * 4;
# 一色で2面子 , 別の一色で2面子, 残り16種のどこかで雀頭 $RyanPeiko += MahjongCalc::OneColor::pairs( 2 , 0 ) * 3 * MahjongCalc::OneColor::pairs( 2 , 0 ) * 2 * 16; $Paishi += MahjongCalc::OneColor::paishi( 2 , 0 ) * 3 * MahjongCalc::OneColor::paishi( 2 , 0 ) * 2 * 16; $Cases += MahjongCalc::OneColor::cases( 2 , 0 ) * 3 * MahjongCalc::OneColor::cases( 2 , 0 ) * 2 * 16 * 4;
# 一色で2面子 , 別の一色で1面子1雀頭, みっつめの色で1順子 $Paishi += MahjongCalc::OneColor::paishi( 2 , 0 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 1 ) * 2 * 7; $Cases += MahjongCalc::OneColor::cases( 2 , 0 ) * 3 * MahjongCalc::OneColor::cases( 1 , 1 ) * 2 * 7 * 64;
# 一色で2面子 , 別の一色で1面子1雀頭, 残り16種のどこかに1刻子 $Paishi += MahjongCalc::OneColor::paishi( 2 , 0 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 1 ) * 2 * 16; $Cases += MahjongCalc::OneColor::cases( 2 , 0 ) * 3 * MahjongCalc::OneColor::cases( 1 , 1 ) * 2 * 16 * 4;
# 一色で1面子1雀頭 , 別の二色で1面子ずつ , 字牌刻子 $Paishi += MahjongCalc::OneColor::paishi( 1 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * 2 * 7; $Cases += MahjongCalc::OneColor::cases( 1 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * 2 * 7 * 4;
# 一色で1面子1雀頭 , 別の一色で1面子 , 字牌2刻子 $Paishi += MahjongCalc::OneColor::paishi( 1 , 1 ) * 3 * MahjongCalc::OneColor::paishi( 1 , 0 ) * ( 7 * 6 / 2 ); $Cases += MahjongCalc::OneColor::cases( 1 , 1 ) * 3 * MahjongCalc::OneColor::cases( 1 , 0 ) * 2 * ( 7 * 6 / 2 ) * 4 * 4;
# 一色で1面子1雀頭 , 字牌時3刻子 $Paishi += MahjongCalc::OneColor::paishi( 1 , 1 ) * 3 * ( 7 * 6 * 5 / 3 ); $Cases += MahjongCalc::OneColor::cases( 1 , 1 ) * 3 * ( 7 * 6 * 5 / 3 ) * 4 * 4 * 4;
# 三色で1面子ずつ , 字牌で雀頭 $Paishi += MahjongCalc::OneColor::paishi( 1 , 0 ) ** 3 * 7; $Cases += MahjongCalc::OneColor::cases( 1 , 0 ) ** 3 * 7 * 4 ;
# 二色で1面子ずつ , 字牌2刻子1対子 $Paishi += MahjongCalc::OneColor::paishi( 1 , 0 ) ** 2 * ( 7 * 6 / 2 ) * 5; $Cases += MahjongCalc::OneColor::cases( 1 , 0 ) ** 2 * ( 7 * 6 / 2 ) * 16 * 5 * 6;
# 一色で1面子 , 字牌3刻子1対子 $Paishi += MahjongCalc::OneColor::paishi( 1 , 0 ) * ( 7 * 6 * 5 / ( 3 * 2 ) ) * 4; $Cases += MahjongCalc::OneColor::cases( 1 , 0 ) * ( 7 * 6 * 5 / ( 3 * 2 ) ) * 64 * 4 * 6;
# 字一色 my $tzuiso = ( 7 * 6 * 5 * 4 / ( 4 * 3 * 2 * 1) ) * 3 ; $Paishi += $tzuiso; $Cases += $tzuiso * 4 * 4 * 4 * 4 * 6; undef $tzuiso; # 出力 my $mentzCases = $Cases; print "Check: 七対子, 国士を含まない 和了形の牌姿 : " , $Paishi , "\n"; print "Check: 七対子, 国士を含まない 和了の数 : " , $Cases , "\n";
# 七対子の牌姿をすべて数えて、二盃形の数を引く
my $sevenpairs = ( 34 * 33 * 32 * 31 * 30 * 29 * 28 ) / ( 7 * 6 * 5 * 4 * 3 * 2 * 1 ); $sevenpairs -= $RyanPeiko; print "Check: 二盃口でない七対子の牌姿 : " , $sevenpairs , "\n"; $Paishi += $sevenpairs; $Cases += $sevenpairs * ( 6**7); undef $sevenpairs; undef $RyanPeiko;
# 国士無双 $Paishi += 13; $Cases += 13 * ( 4**12) * 6;
my $all = ( 136 * 135 * 134 * 133 * 132 * 131 * 130 * 129 * 128 * 127 * 126 * 125 * 124 * 123) / ( 14 * 13 * 12 * 11 * 10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1 ) ;
my $tenhoP = $mentzCases * 100 / $all; my $tenho = $all / $mentzCases; print "Check: 七対子, 国士を含まない"; printf( "天和の確率、およそ %.3g%% , つまり %.3g回に一回\n" , $tenhoP , $tenho);
$tenhoP = $Cases * 100 / $all; $tenho = $all / $Cases;
printf( "天和の確率、およそ %.3g%% , つまり %.3g回に一回\n" , $tenhoP , $tenho); print "牌姿の数は: " , $Paishi , "\n"; printf( "計算式は %.3g ÷ %.3g\n" , $all , $Cases );
1 コメント:
投稿後、どこかケースに数え落としがあって、きちんと定説通りの数字と一致することを当時三日後くらいに気づいたが、直していなかったといういわくつきの記事です。
当時はどちらかというとプログラマとしてのアピールが強かったし、まさか、この数年後に雀荘のスタッフとして麻雀業界に復活するとは考えてなかったから、修正が面倒くさかったのです
コメントを投稿