テンパイ判定

3秒くらいで結果が出るようになった。

メンツの探索中に非メンツが、アタマありの場合2個、アタマなしの場合1個みつかったら探索を中止する。

本当はこの判断が入っているので最後にメンツの数をチェックする必要はないと思ったのだが、
メンツの数が足りないのに最後まで行く場合がかなりある。

また、中止する場合にlastでループを抜けてよいと思ったのだがそれをやると答えが足りなくなる。

use strict;
use warnings;

if($#ARGV < 0){
print "please specify haipai.\n";
exit;
}

my @haipai = sort split //, shift;

if($#haipai != 12){
print "please specify 13 pies.\n";
exit;
}
my @menz;

my %tenpai;

my $menz_count = 0;
my $head_count = 0;
my $tenpai_count = 0;
my $not_menz = 0;

my $select_head = 0;

print "haipai: @haipai\n";

&select_head([@haipai]);

$head_count = 0;

&select_menz([@haipai],[@menz],"");

# 結果表示
foreach my $name (sort keys %tenpai){
$tenpai_count++;
print "$tenpai_count : $name\n";
}


#アタマを選んだ後、メンツを選ぶ
sub select_head{
my @haipai = @{ $_[0] };

my ($i, $j) = (0, 1);

$head_count++;

while($i <= $#haipai - 1){
if($haipai[$i] == $haipai[$j]){
#                       print "$head_count: <".$haipai[$i].$haipai[$j].">\n";
my $atama = "<".$haipai[$i].$haipai[$j].">";

my @menz;

#選んだ牌を消す
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#残ったパイからメンツを選ぶ
&select_menz([@new_haipai], [@menz], $atama);
}

$j++;
if($j>$#haipai){
$i++;
$j=$i+1;
}

}
}


sub select_menz{
my @haipai = @{ $_[0] };
my @menz = @{ $_[1] };
my $atama = $_[2];

my ($i,$j, $k) = (0, 1, 2);

# 牌の残りが2枚以下
if($#haipai < 2){
# アタマあり
if($head_count > 0) {
#メンツが3個以上
if($#menz > 1){
#残りの牌がターツかトイツ
if(&amari_check([@haipai])>0){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
#                                       print "$tenpai\n";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
#                               print "$tenpai\n";
&tenpai_check($tenpai);
}
return;
}
}

while($i <= $#haipai - 2){

my @new_menz = @menz;

if($haipai[$i]+1 == $haipai[$k]){
$not_menz++;
}elsif(($haipai[$i] == $haipai[$j] && $haipai[$j] == $haipai[$k]) ||
($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])){
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#アタマありの場合非メンツが２つ、なしの場合１つあれば探索中止

if(($head_count == 0 && $not_menz > 0) ||
($head_count > 0  && $not_menz > 1)) {
$not_menz = 0;
}else{
#選んだパイを削除
my @new_haipai = @haipai;
$new_haipai[$i]=0;
$new_haipai[$j]=0;
$new_haipai[$k]=0;

@new_haipai = grep { $_ > 0 } @new_haipai;

#再帰呼び出しで残り牌からメンツを選ぶ
&select_menz([@new_haipai], [@new_menz], $atama);

}

$k++;
if($k>$#haipai){
$j++;
if($j>$#haipai -1){
$i++;
$j=$i+1;
$k=$j+1;
}else{
$k=$j+1;
}
}

}
}

#重複した聴牌形をハッシュでチェック
sub tenpai_check{
my ($tenpai) = @_;
#       print "tenpai check :$tenpai\n";
$tenpai{$tenpai}++;
}

#余り牌がターツあるいはトイツであるかをチェック
sub amari_check{
my @haipai = @{ $_[0] };

if($haipai[0] == $haipai[1]){
return 1;
}
if($haipai[0]+1 == $haipai[1]){
return 1;
}
if($haipai[0]+2 == $haipai[1]){
return 1;
}
}