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