#!/usr/bin/perl -w
#
#  Purpose -- solves the "knight's tour" problem, where a knight must
#             move from a starting square to all 63 other squares of
#             the chessboard, without occupying any square twice.
#
                                                                                
use strict;
use warnings;
                                                                                
use Data::Dumper;
                                                                                
#
#  The Board
#
#  a8  b8  c8  d8  e8  f8  g8  h8
#  a7  b7  c7  d7  e7  f7  g7  h7
#  a6  b6  c6  d6  e6  f6  g6  h6
#  a5  b5  c5  d5  e5  f5  g5  h5
#  a4  b4  c4  d4  e4  f4  g4  h4
#  a3  b3  c3  d3  e3  f3  g3  h3
#  a2  b2  c2  d2  e2  f2  g2  h2
#  a1  b1  c1  d1  e1  f1  g1  h1
#
                                                                                
# Valid move offsets for a knight (delta-x, delta-y)
my $pmoves = [
    [ -2,  1 ], [ -1,  2 ], [  1,  2 ], [  2,  1 ],
    [  2, -1 ], [  1, -2 ], [ -1, -2 ], [ -2, -1 ],
];
                                                                                
# Construct hash of legal moves (key = from, value = to)
my $plegal = { };
for (my $i = 0; $i < 8; $i++) {
    for (my $j = 0; $j < 8; $j++) {
        foreach my $pmove (@$pmoves) {
            my ($row1, $col1) = ($i + $pmove->[1], $j + $pmove->[0]);
            next if ($col1 < 0 or $col1 > 7 or $row1 < 0 or $row1 > 7);
            my $from = chr(ord('a') + $j)    . ($i + 1);
            my $to   = chr(ord('a') + $col1) . ($row1 + 1);
            $plegal->{$from} ||= [ ];
            push @{$plegal->{$from}}, $to;
        }
    }
}

# Solve the puzzle
my $start = time;
try_square('a8', 63);
printf "Total time = %d seconds\n", time - $start;
                                                                                
                                                                                
#################
## Subroutines ##
#################
                                                                                
#
#  Input
#    $1 ... a square (eg. 'a1' or 'c5') to move to
#    $2 ... the total number of moves to make
#    $3 ... a hash whose keys are all the occupied squares
#    $4 ... the solution list
#
#  Output
#    $1 ... the result:  -1 = square was unoccupied
#                         0 = square already occupied
#                         1 = solution found
#
#  Results
#    Marks the specified square as occupied (in the hash), and then
#    recursively attempts to move next to all squares which are valid.
#    If a solution is found, show_solution() is called to display it.
#
sub try_square {
    my ($square, $nmoves, $ptaken, $psolution) = @_;
                                                                                
    # Initialization
    $ptaken    ||= { };
    $psolution ||= [ ];
                                                                                
    # Square already taken
    ($ptaken->{$square} || 0) and return 0;
                                                                                
    # Square is unoccupied -- fill it
    $ptaken->{$square} = 1;
    push @$psolution, $square;
                                                                                
    # Finished trying all N squares -- show solution
    if ($nmoves == @$psolution) {
        printf "Found solution!  %s\n", Dumper($psolution);
        my $pboard = { };
        map { show_solution($_, $pboard) } @$psolution;
        return 1;
    }
                                                                                
    # Now try each valid move starting at this square
    my $pmoves = $plegal->{$square};
    foreach my $move (@$pmoves) {
        my $result = try_square($move, $nmoves, $ptaken, $psolution);
        ($result > 0) and return 1;
        if ($result) {
            # Remove piece from the board and solution list
            delete $ptaken->{$move};
            pop @$psolution;
        }
    }
                                                                                
    return -1;
}

                                                                                
#
#  Input
#    $1 ... a square (eg. 'a1' or 'c5') to move to
#    $3 ... a hash whose keys are all the previously occupied squares
#
#  Results
#    Displays the square moved to, as well as all previously
#    occupied squares.
#
sub show_solution {
    my ($square, $pboard) = @_;
    my $rownum = $square;
    my $colnum = ord(substr($rownum, 0, 1, "")) - ord('a') + 1;
    for (my $row = 1; $row <= 8; $row++) {
        for (my $j = 1; $j <= 8; $j++) {
            my $col = chr(ord('a') + $j - 1);
            my $this_square = $col . $row;
            my $sym = exists($pboard->{$this_square})? "xx": "..";
            if ($rownum == $row and $colnum == $j) {
                $sym = chr(ord('a') + $j - 1) . (9 - $row);
            }
            print "$sym ";
        }
        print "\n";
    }
    $pboard->{$square} = 1;
    print "\n\n";
}