麻雀の確率 ( vol.2 天和の確率が定説と違う )

前の記事 を書き終わった瞬間、通常の麻雀の天和の確率もそれほど面倒くさくないと思えた。しかしデバッグしながらプログラムを書いたら、それでも半日かかった。

最初の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 );

麻雀の確率 ( vol.1 一色麻雀で天和の確率を )

麻雀を覚えた 1986年、当時出ていた関連の書籍を新刊・古本あわせて45冊集めて読んだ。

その中に、コンピュータで14枚の牌姿をすべてのケースを示すと 何通り。そのうちに和了の形がいくつ。よって天和の確率はいくつ、と書いてある本があった。

署名は忘れた。既に手放したから、私が読んだときに理解を間違えて、そのまま20年以上を過ごしてきたのかもしれない。

---

最近、清一にしようとやみくもに 13枚同じ色を集めたときに、聴牌である確率はどれくらいかと考え出した。頭の体操にほどよい問題と思った。

9種類4枚ずつの牌から13枚抜き出して、その形から、聴牌のものを抜き出してケースを数えたら良いのかと思い、数えるプログラムを二、三日考えていた。

---

ちょっと待て。違うではないか。すべての牌姿は、同じ確率では出現しない。

一色36枚から 4枚を抜き出したときに、たとえば 1111 である確率は、1234 である確率の 256 分の 1 だ。

詳しく言えば、ある牌姿のなかに同じものが4枚あるとしたら、その部分については 1通りしかない。3枚だとしたら 4通り。2枚だと 6通り、1枚だと 4通り。

---

上記の本を読んだ18歳のときに、麻雀を考える時には、量子力学のように、ふたつの同種の牌を同じに確率計算するのかと感じて、感じながらなぜかそのまま受け入れていたのよね。

そんなバカなわけはない。一筒四枚に花・鳥・風・月と書いてあれば、2枚が手の中にある場合の数は 花鳥・花風・花月・鳥風・鳥月・風月の6通りで間違いない。

バカだねぇ。＞ 18歳のわたし

---

一色9種36枚の麻雀牌から14枚を取ったときの確率を計算するためのすべてのケースは、( 36 × 35 × 34 × ... × 23) ÷ ( 14 × 13 × 12 × ... 1) 通り。だいたい2.66 × 10の11乗 ( 266億 ) として間違いはない。

ここで Perl スクリプトをでっち上げて計算してみた。とりあえず一色手を計算するには十分というだけの、汚いコードならば 90分でできた。実行時間は 0.5秒。

和了の牌姿は、 13277 通り、 445632532 ケース。

2.66 × 10 の11乗 のうちの、4.46×10の9乗だから、一色麻雀だとだいたい 60回に一回の天和になるのか。うん、昔一色手の練習で二人麻雀をしていた時の感覚とだいたいあってる。

---

同じロジックで、力技で 34種類の牌を使ったふつうの麻雀の天和の確率も計算は可能。力技のコード書くのは面倒くさいし汚いから省略。

もうちょっと綺麗に書いたコードを公開するときがきたら、結果の照合に書いてしまうかもしれないが。

そして、この一色手のすべての和了形を出力したものから、一枚引いて重複を省くことで、清一の聴牌形をすべて抜き出そうと思っている。

参考 : 使用したコード

!/usr/bin/perl
#
#   allcaasecount.pl      2011-09-10 yaemon
#
use strict;
use warnings;
use bignum;

my $all =  ( 36 * 35 * 34 * 33 * 32 * 31 * 30 * 29 * 28 * 27 * 26 * 25 * 24 * 23) / 
      ( 14 * 13 * 12 * 11 * 10 * 9  * 8  * 6   * 5  * 4 * 3  * 2  *  1 ) ;

   print $all , "\n";

#!/usr/bin/perl
#
#   OneColorMahjongCases.pl      2011-09-10 yaemon
#
use strict;
use warnings;
use bignum;

sub merge( $$ );
sub cases( $ );

my @mentz;

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 ];

my @head;
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 ];


my %answer;

my $test = 0;
for ( my $i = 0 ; $i < @mentz ; $i++ )
{
 for ( my $j = $i ; $j < @mentz ; $j++ )
 {
  my $twomentz = merge( $mentz[$i] , $mentz[$j] );
  if ( $twomentz ) 
  {
   for ( my $k = $j ; $k < @mentz ; $k++ )
   {
    my $threementz = merge( $twomentz , $mentz[$k] );
    if ( $threementz )
    {
     for ( my $l = $k ; $l < @mentz ; $l++ )
     {
      my $fourmentz = merge( $threementz , $mentz[$l] );
      if ( $fourmentz )
      {
       for( my $m = 0 ; $m < @head ; $m++ )
       {
        my $hand = merge( $fourmentz , $head[$m] );
        if ( $hand )
        {
         my $tmp = join( "" , @$hand );
         if( !  exists( $answer{ $tmp } ) )
         {
          $answer{ $tmp  } = cases( $hand );
         }
        }
       }
      }
     }
    }
   }
  }
 }
}

# 七対子を忘れていた。ここは手抜きする
my $sevenpairscase = 6**7;
for ( my $i = 0 ; $i < 9 ; $i++ )
{
 for ( my $j = $i + 1 ; $j < 9 ; $j++ )
 {
  my @hand;
  for ( my $k = 0 ; $k < 9 ; $k++ )
  {
   if ( $k == $i || $k == $j )
   {
    push @hand , 0;
   }
   else
   {
    push @hand , 2;
   }
  }
  my $tmp = join( "" , @hand );
  if( !  exists( $answer{ $tmp } ) )
  {
   $answer{ $tmp  } = $sevenpairscase;
  }
 }
}



my $num  = keys( %answer );
print "All cases is $num\n";
my $cases = 0;
while ( ( my $hand , my $case ) = each(  %answer ) )
{
 $cases += $case;
 print $hand , "\n";
}
print "\nall cases is $cases\n";



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;
}

sub cases( $ )
{
 my $u = shift;
 my $case = 1;
 for ( my $i = 0 ; $i < 9 ; $i++ )
 {
  if ( $$u[$i] == 0 )
  {
   next;
  }
  elsif ( $$u[$i] == 1 )
  {
   $case *= 4;
  }
  elsif ( $$u[$i] == 2 )
  {
   $case *= 6;
  }
  elsif ( $$u[$i] == 3 )
  {
   $case *= 4;
  }
  elsif ( $$u[$i] == 4 )
  {
   next;
  }
 }
 return $case;
}

久々に麻雀について

久々に麻雀について書いてみようか

かつてツキの流れはあるか、ないかという話題が長く論を呼んだことがあった。いま現在もどこかでは論議されているだろう。

「麻雀は認識のゲーム」と阿佐田哲也の名前で語った方がいた。その文芸の先輩、五味氏も言った。問題はツキが実在するか、しないかではない。

エラーを自覚したとき、結果に不満を感じたあと、配牌を腐った(悪化した)と感じる。その感覚がベテランであれ無垢の初心者であれ、振り払いがたく襲うということ。それが問題の焦点だ。

ツキが悪化したと感じると状況への対処が鈍る。楽しみも損なう。ツキの有無は無視しても、自分の心や対局相手の認識が変わるというのは、紛れもない真実。それもまた状況のひとつ。

感覚に身を委ねて対処するのも、非科学的だと否定し、プロパガンダして対局相手の認識からも拭い去ることを意図するのも。

私の見聞していた限りではこの二つが双璧だった。他にも対処はあるかもしれない。最も効果ある対策が何かは検証不能だから、一度限りの出来事の積み重ねだから、ゲームに魅せられる人はあとを絶たない。

事象に法則を見つけることに目を奪われ、自分の心の動き、他者の認識の変化という目の前の出来事を無視するのは、「近代知」,「科学の方法論」の罠だな…

というような思いを「河合隼雄対話集」(1994 ISBN4-89583-139-6) や 「臨床の知とは何か」(中村雄二郎1992 ISBN4-00-430203-X) から受けた

追記 04-08

mixi 方面に、まだ私の麻雀について語っていたころの知り合いが多くいらっしゃるので、ふと反応をみてみたくて書いてみた。

あちらの足跡を見る限り、どうも誰も私の麻雀に対するコメント・随想など求めていないみたいね。それはそれで清々しく、すっきり。