七対子対応

最初は、通常のテンパイ判定を改造して、3つ選ぶのを2枚にして、メンツの数は5つにして・・・とやったのだが、なぜかうまくいかなかった。

配牌はソートしているから隣と同じでなければ即非メンツに判定できることに気づいて、別途作った。

あとはループのさせ方がちょっと変だったのでなおしたら、1秒くらいで判定するようになった。

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

@menz=();
$not_menz = 0;
$head_count = 0;

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

#七対子
&chitoi([@haipai]);

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


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

my ($i, $j);

$head_count++;

for($i=0;$i <= $#haipai - 1;$i++){
for($j=$i+1;$j <= $#haipai;$j++){
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);
}
}
}
}


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

my ($i,$j, $k);

# 牌の残りが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)."]";
&tenpai_check($tenpai);
}
}
return;
# アタマなし
}else{
#メンツが4個以上
if($#menz > 2){
my @sorted = sort @menz;
my $tenpai = $atama.join("",@sorted)."[".join("",@haipai)."]";
&tenpai_check($tenpai);
}
return;
}
}


for($i=0;$i<= $#haipai - 2;$i++){
for($j=$i+1;$j<= $#haipai - 1;$j++){
for($k=$j+1;$k<= $#haipai;$k++){

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

}
}
}
}
}

sub chitoi{
my @haipai = @{ $_[0] };

my $i = 0;
my @menz;

$menz_count = 0;

while($i<$#haipai){
if($haipai[$i] == $haipai[$i+1]){
push @menz,"(".$haipai[$i].$haipai[$i+1].")";
$menz_count++;
if($i==$#haipai-2){
push @menz,"[".$haipai[$#haipai]."]";
}
$i+=2;
}else{
push @menz,"[".$haipai[$i]."]";
$i++;
}
}

if($menz_count>5){
my $tenpai = join("",@menz);
&tenpai_check($tenpai);
}
}


#重複した聴牌形をハッシュでチェック
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;
}
}