ほぼ完成

とりあえず、聴牌形を出すまでできた。ただしチートイツは除く。

チュウレンポウトウの9面待ちで１１パターンが出るので合ってるんじゃないかな。
でも、すごく遅い。30秒くらいかかる。
聴牌形を選ぶ時点で重複があることがわかっている。
なので、最後にハッシュに登録してチェックしている。

use strict;
use warnings;

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

my @haipai = split //, shift;

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

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

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

my @new_menz = @menz;
#コーツ
if(($haipai[$i] == $haipai[$j] && $haipai[$i] == $haipai[$k])
#シュンツ
|| ($haipai[$i]+1 == $haipai[$j] && $haipai[$j]+1 == $haipai[$k])) {
push @new_menz, "(".$haipai[$i].$haipai[$j].$haipai[$k].")";
}else{
#メンツにならなかったらカウント
$not_menz++;
}
#非メンツが2個以上になったら探索中止
if($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;
}
}

実行結果

# perl menz.pl 1112345678999
haipai: 1 1 1 2 3 4 5 6 7 8 9 9 9
1 : (111)(234)(567)(999)[8]
2 : (111)(234)(678)(999)[5]
3 : (111)(345)(678)(999)[2]
4 : <11>(123)(456)(789)[99]
5 : <11>(123)(456)(999)[78]
6 : <11>(123)(678)(999)[45]
7 : <11>(345)(678)(999)[12]
8 : <99>(111)(234)(567)[89]
9 : <99>(111)(234)(789)[56]
10 : <99>(111)(456)(789)[23]
11 : <99>(123)(456)(789)[11]