麻雀の待ち判定

http://www.itmedia.co.jp/enterprise/articles/1004/03/news002.html

泥臭い解き方。。これで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");
}