色対応

できた。
配牌はスペースで区切って指定する。 昨日直したときの修正ミスがあったのでそれもなおす。

use strict;
use warnings;

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

#my @haipai = sort split / /, shift;
my @haipai = sort @ARGV;

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(&is_menz($haipai[$i],$haipai[$j])==3){
                my $atama = "<".$haipai[$i].$haipai[$j].">";
#               print $atama."\n";

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

                @new_haipai = grep { $_ ne "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(&is_menz(@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(&is_menz($haipai[$i], $haipai[$j], $haipai[$k]) > 0) {
                    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 { $_ ne "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(&is_menz($haipai[$i], $haipai[$i+1]) == 3){
            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;
    }
}

sub is_menz{
    my @pais = @_;

#   print "pais:@pais\n";

    if($#pais == 1){
        if($pais[0] eq $pais[1]){
            return 3;
        } elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && (substr($pais[0],0,1) ne "x")){
            if(substr($pais[0],1,1)+1 == substr($pais[1],1,1)){
                return 4;
            }elsif(substr($pais[0],1,1)+2 == substr($pais[1],1,1)){
                return 5;
            }else{
                return 0;
            }
        }else{
            return 0;
        }
    }

    if($pais[0] eq $pais[1] && $pais[0] eq $pais[2]){
        return 2;
    }elsif(substr($pais[0],0,1) eq substr($pais[1],0,1) && substr($pais[0],0,1) eq substr($pais[2],0,1) && (substr($pais[0],0,1) ne "x")){
        if(substr($pais[0],1,1)+1 == substr($pais[1],1,1) && substr($pais[0],1,1)+2 == substr($pais[2],1,1)){
            return 1;
        }else{
            return 0;
        }
    }else{
        return 0;
    }
}

実行結果

# perl menx.pl m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
haipai: m1 m2 m3 p1 p2 p3 s3 s4 s5 s6 s7 x1 x1
1 : (m1m2m3)(p1p2p3)(s3s4s5)[s6s7]
2 : (m1m2m3)(p1p2p3)(s5s6s7)[s3s4]