最初の6時間で書いたプログラムでは、およそ2千万回に一度という数字が出た。ここで定説を調べる。33万回に一回と言われているようだ。む、おかしい。別の数字が出るのは期待していたが、定説より頻繁に出るという予想をしていたのに。 ……清一以外の面子手は、3面子1雀頭で牌姿を出すという大ポカをしていた。道理で両盃口チェックがほとんど必要なかったわけだ。
#!/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 );
