うなぎ食べたい

unagi.pl

#!perl
use strict;
use warnings;

sub unagi_nqueen {
    my $n = shift;
    my $answer = [];

    _nqueen([], $n, 0, $answer);
    _unagi_filter($n, $answer);
}

sub _nqueen {
    my ($board, $n, $index, $answer) = @_;

 OUTER:
    for (my $i = 0; $i < $n; $i++) {
        for (my $j = 0; $j < $index; $j++) {
            if ($board->[$j] == $i
            || ($board->[$j] - ($index - $j)) == $i
            || ($board->[$j] + ($index - $j)) == $i) {
                next OUTER;
            }
        }

        $board->[$index] = $i;
        if ($index == ($n - 1)) {
            push @{$answer}, [ @{$board} ];
        } else {
            _nqueen($board, $n, $index + 1, $answer);
        }
    }
}

my $table = [
 [ qw/l h i k o a v/ ],
 [ qw/r q s c z l p/ ],
 [ qw/u w a l n f o/ ],
 [ qw/t y k a j e h/ ],
 [ qw/a h i t s y d/ ],
 [ qw/e f o p t x n/ ],
 [ qw/r u z w y v e/ ],
];

sub _unagi_filter {
    my ($n, $answers_ref) = @_;

    my @candidates = grep { $_->[2] == 2 && $_->[3] == 4 } @{$answers_ref};
    die "Answer is too mush!!" unless scalar @candidates == 1;

    my $i = 1;
    my $word = join '', map {
        $_->[0]
    } sort {
        $a->[1] <=> $b->[1]
    } map {
        my $ret = [ $table->[$_]->[$i - 1], $i * $_ ];
        $i++;
        $ret;
    } @{$candidates[0]};

    return $word;
}

printf "answer is '%s'\n", unagi_nqueen(7);