白露巳の日、鎌倉銭洗い弁天に訪れる / 9月14日 , 11月6日 記載

今日は、飼っている猫が望むので闘猫に出したら、なぶり殺し寸前の目にあって帰ってきた夢をみた。

対戦相手の猫に教えられたダンボール箱の中から救いだし。まだ息があった。こんなに黒くて小さい猫だったかと思いながら心臓のあたりをマッサージしつつ、もう片手で獣医を探ししているシーンで目が覚めた。

妙な夢だ。

---

週末の話を書く。

金曜日の夜から、麻雀で天和の起きる確率をコンピュータに計算させはじめたら寝食と排泄を忘れた。

夕方には気持ちが悪くなった。昔は仕事でもよくあったことだし、昔なら注意して集中しないようにするようにしていたのだが、久しぶりで警戒を忘れていた。

気絶するように眠ったのは、夜も更けてから。二連続の気絶するような入眠だった。

---

起きたら7時。

先月末29日に、陽灼けの皮を剥くように全身の皮を自分で剥く夢をみた。たしか mixi の voice にはこう書いた。

ひと皮を剥ぐ (「もっけ」)とかひと肌脱ぐ(「戯言/ネコソギラジカル」) て感じの夢をみたが、人皮を脱ぎ捨ててもやっぱり人だろう

連想して蛇にちなんだ伝承をひょっこり調べた。

宇賀神という神様の言い伝えが一部にあるそうな。

古事記にある食べ物関係の神様が似た名前なので上書きされ、さらに蛇と水の神様ということで弁天と混同されて説話も石像もほとんど残っていないが。銭洗い弁天の名で有名な鎌倉の神社にみることができるという。

白露巳の日にお祭りがあるらしい。

白露というのは二十四季のひとつで秋。調べると今年は9月8日からの15日。

暦を計算することができるページも探しだし、そのあとの巳の日は10日日曜日と判明。

せっかくだから、見にいくならばその日だと決めていた。

とくに夢と神様を結びつけはしない。だが、夢をみるような古い心の動きは、昔からいろいろの人が体験してなにかを残しているものだとは思っている。

だが、神社のサイトにも鎌倉の観光案内にも、きちんと9月10日と書いてあるものはなく賭けになるという思いもあった。

それゆえスケジュールにメモはしていたが、あくまで備忘。確定させてもいなかったが、行こうという気になった。

どうしようかと迷っていたのを、朝起きて行く気になっていたなんて体験は、去年の3月以来だ。

---

小田急で経堂から藤沢に向かい、窓の外を見ながら考えた。

今年になってから、信仰に近い思い入れを込めて神社巡りを好む友人が幾人かできた。だが私は信仰深いとも思っていない。神社が好きというほどのものもない。この確たる目的も探し物もなく「行ってみよう」という気持ちはなんなのだろう。

結論は出ない。楽しいから行くとか、これを勉強したいから行くというわかりやすい動機がなくても行動して良いのだろう。動機を自分で納得できなくとも動いて良いのだろうし、めったにないことだから素直になることにしよう。

---

藤沢から JR に乗り換え、大船で乗り換えて鎌倉へ。

駅のホームから大きな石像がみえると、存在を忘れていたらまぁぎょっとする。

乱歩の怪人二十面相、ほかにもひとつ、ふたつ。大船観音の中をくりぬいて悪党がアジトにするという設定の小説があったな。

街を見下ろしている感じの大きな石像、悪党のアジトにして最後は壊れるという空想くらいしか使いみちもないだろう、当然という気がした。それくらいぎょっとする。

---

と、ここまで書いたところで一度中断。先週の木曜日からいきなり忙しくなった。(14日9時5分)

以下、11月6日未明に補足

鎌倉の駅を降りたところで驟雨。ある本には 水神のところに行くのに雨が降るのは、神様と会えるということと昔から言われる とあったな。

もっとも私は、寺社仏閣に訪れたくなるようなときは、低気圧で心がそっちに向くのだろうと理解しているので、これはまぁ余談。コンビニで傘を買い求めて歩き出す。

---

民家の中をとおり、丘を上がりかけた途中に洞穴があり、その向こうが宇賀神・銭洗弁天。境内を歩き回るうちに、あと30分でお祭りと奉納神楽があるというアナウンスが流れた。

境内に舞台があり、その前に長椅子が何列か置いてある。だが、私はわきの茶店にこしを落ち着けた。

……なんだろうね。

奉納神楽そのものを観るより、わきで人のざわめく気配を肌で感じる方が好きだと気づく。友人や恋人も、そんなひねった嗜好の持ち主ばかり選ぶくせに、自分が企画して人を連れていくと、つい神楽そのものを観せたいと椅子に座ってしまう。それでは、ロクなことにならないよな。

しばらくして席を立ち、茶店で手に入れた観光地図を頼りに、南鎌倉の駅に向けてハイキング道を登った。俯瞰して人の流れをみるのも素晴らしい。

---

帰りの電車から、雲がジェットコースタの軌道のように、３６０°の円環を描き、出発点よりずれたところで下の大きな雲に合流しているのをみた。

ちかごろ雲の流れをみるのがおもしろい。電車の中での読書が、もったいなくて進まない。

それは私の視覚が。いや、視覚の処理をして得る情報が、鮮明に三次元になってきたせいだ。

はじめは何事が起きたのかと思った。正直疲れる。だが、疲れ以上に美しさを感じるので、やめられない。

麻雀の確率 ( 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;
}

本日づけの vim でコンパイルエラー

kikansah.jp を再開できそうなめどが立って、古いサーバの手入れで昨日に vim の最新版 (表示は 7.3.107 )を hg で取ってきてコンパイルした。ふつうに入った。

昨日はそのとき、自宅 PC の ruby も更新した。それゆえ、ruby と perl , python が vim のスクリプトから使えるほうの拡張版が動かなくなった。gvim に使っていて、ないと困るので今日再コンパイル。

再コンパイル時にまた最新ソース (これも表示は 7.3.107 )に更新したら、コンパイルエラー。Undefined routine ExtUtils::ParseXS::error だったかな。

perl の version は 5.14.1。cpanp コマンドを起動して ExtUtils::ParseXS モジュールを入れて、コンパイルは通った。

警告がいくつか流れていたし、perl が動くかテストするためだけの vim script が手許にないので、コンパイルできたってところまでしか確認していないが。とりあえず。