泥臭い解き方。。これで2時間近くかかった。。。
use strict;
use warnings;
my %ret;
sub maj_splice {
my ($ps, $len) = @_;
my @w = @$ps;
my @cup = splice(@w, 0, $len);
my $cup = join "", @cup;
return (\@w, $cup);
}
sub search {
my ($p, $machi, $atama, $syun, $kou) = @_;
if (@$p) {
if (!$atama) {
if (!$machi) {
# 頭待ち
my ($w, $cup) = maj_splice($p, 1);
search($w, "[$cup]", 1, $syun, $kou);
}
if (1 < @$p && $p->[0] == $p->[1]) {
# 頭
my ($w, $cup) = maj_splice($p, 2);
search($w, $machi, 1, $syun, $kou."($cup)");
}
}
if (!$machi) {
if (1 < @$p && $p->[0] == $p->[1]) {
# 刻子待ち
my ($w, $cup) = maj_splice($p, 2);
search($w, "[$cup]", 0, $syun, $kou);
}
my @w = @$p;
my $top = shift @w;
for my $i (0..$#w) {
if ($w[$i] == $top + 2) {
# カンチャン待ち
splice @w, $i, 1;
search(\@w, "[".$top.($top+2)."]", $atama, $syun, $kou);
last;
}
}
}
if (2 < @$p) {
if ($p->[0] == $p->[1] && $p->[1] == $p->[2]) {
# 刻子
my ($w, $cup) = maj_splice($p, 3);
search($w, $machi, $atama, $syun, $kou."($cup)");
}
}
if (1 < @$p) {
my @w = @$p;
my $top = shift @w;
my $n = 1;
for my $i (0..$#w) {
$i -= ($n - 1);
if ($w[$i] == $top + $n) {
$n++;
splice @w, $i, 1;
if (!$machi && $n == 2) {
# 順子待ち
my @ww = @w;
search(\@ww, "[".$top.($top+1)."]", $atama, $syun, $kou);
}
if ($n == 3) {
# 順子
my @ww = @w;
search(\@ww, $machi, $atama, $syun."(".$top.($top+1).($top+2).")", $kou);
}
}
}
}
} else {
$ret{$syun.$kou.$machi} = 1;
}
}
sub main {
my $input = shift;
print $input, "\n";
my @pai_list = split //, $input;
if (@pai_list != 13) {
print "please input 13 chars\n";
exit -1;
}
@pai_list = sort {$a <=> $b} @pai_list;
%ret = ();
search(\@pai_list, 0, 0, "", "");
for my $r (keys %ret) {
print $r, "\n";
}
}
if (@ARGV) {
main($ARGV[0]);
} else {
main("1112224588899");
main("1122335556799");
main("1112223335559");
main("1223344888999");
main("1112345678999");
}
