solve-8-puzzle.pl

#!/usr/bin/perl -Twl

use strict;

# Solves the sliding puzzle with 8 numbered tiles using the A-star algorithm
# and a Manhattan Distance heuristic.
#
# Usage: ./solve-8-puzzle.pl "4623 1587"    # Solve puzzle, output statistics
#        ./solve-8-puzzle.pl -b "4623 1587" # Simulate BFS by disabling MD
#
# Takes one argument, the initial board state, as a single nine character
# string. The string must contain a space, and the numbers 1-8, once each.
#
# To convert a board state to such a string, read the numbers off the puzzle
# and write everything together. Use a space to denote the empty square.

# Installing prerequisites:
#     sudo apt-get install cpanm
#     sudo cpanm AI::Pathfinding::AStar

# Sample run:
#
#  ./solve-8-puzzle.pl "74623 158"
# +-------+
# | 7 4 6 |
# | 2 3   |
# | 1 5 8 |
# +-------+
# Unsolvable position.
# Total positions checked: 181440

# This code is published under the EVVKTVH license:
#   http://evvk.com/evvktvh.html#english

package GameOf8;
use base "AI::Pathfinding::AStar";


sub print_board
{
    my ($self, $board) = @_;
    printf("+-------+\n".
       "| %s %s %s |\n".
       "| %s %s %s |\n".
       "| %s %s %s |\n".
       "+-------+\n",
       (split//,$board));
}


sub get_neighbours
{
    my ($self, $board) = @_;

    my @neighbours=(); # list of neighbours to be filled and returned

    my $hole=index($board," ");
    if($hole >= 0 and $hole <=5) # there's a piece under the hole
    {
    my $new=$board;
    substr($new,$hole,1) = substr($new,$hole+3,1);
    substr($new,$hole+3,1) = " ";
    push @neighbours, $new;
    }
    if($hole >= 3 and $hole <=8) # there's a piece above the hole
    {
    my $new=$board;
    substr($new,$hole,1) = substr($new,$hole-3,1);
    substr($new,$hole-3,1) = " ";
    push @neighbours, $new;
    }
    if($hole % 3 != 0) # there's a piece to the right of the hole
    {
    my $new=$board;
    substr($new,$hole,1) = substr($new,$hole-1,1);
    substr($new,$hole-1,1) = " ";
    push @neighbours, $new;
    }
    if($hole % 3 != 2) # there's a piece to the left of the hole
    {
    my $new=$board;
    substr($new,$hole,1) = substr($new,$hole+1,1);
    substr($new,$hole+1,1) = " ";
    push @neighbours, $new;
    }

    return @neighbours;
}


sub manhattan_distance
{
    my ($self,$board)=(@_);


    return 0 if $self->{simulate_bfs};
    # with an always-zero heuristic, A* reverts into Dijkstra's algorithm,
    # which in turn reverts into a breadth-first search (BFS) when each move
    # costs the same.


    my $md = 0;
    for my $x (1,2,3)
    {
    $md += int(index($board,$x)/3);
    }
    for my $x (4,5,6)
    {
    $md += (int(index($board,$x)/3) != 1);
    }
    for my $x (7,8)
    {
    $md += 2 - int(index($board,$x)/3);
    }
    for my $x (1,4,7)
    {
    $md += index($board,$x) % 3;
    }
    for my $x (2,5,8)
    {
    $md += (index($board,$x) % 3 != 1);
    }
    for my $x (3,6)
    {
    $md += 2-(index($board,$x) % 3);
    }
    return $md;
}


sub new
{
    my ($class)=@_;
    return bless {
    callcount       => 0,  # count A-star's calls to getSurrounding.
    node_visited_at => {}, # record when a particular position was reached.
    simulate_bfs    => 0,  # short-circuit manhattan distance heuristic?
    }, $class;
}


# Method required by AI::Pathfinding::AStar
sub getSurrounding
{
    my ($self, $node, $target) = @_;

    $self->{node_visited_at}->{$node} = $self->{callcount}++;

    my @neighbours = $self->get_neighbours($node);
    my $surroundings=[];
    foreach my $neighbour (@neighbours)
    {
    push(@$surroundings,
         [$neighbour, 1, $self->manhattan_distance($neighbour)]
        );
    }
    return $surroundings;
}



package main;

my $map = new GameOf8;
$map->{simulate_bfs} = 1, shift if $ARGV[0] eq "-b";

my $start=pop;

die "Usage: $0 \"14256 837\"\n"
    unless join('', sort split//, $start) eq " 12345678";

my $path = $map->findPath($start, "12345678 "); # do the actual solving

if(@$path)
{
    foreach my $node (@$path)
    {
    GameOf8->print_board($node);
    print("Manhattan distance: ", $map->manhattan_distance($node));
    print "Positions checked: ",  $map->{node_visited_at}->{$node} || "-";
    }
    print "Total moves: ", scalar(@$path)-1;
}
else
{
    GameOf8->print_board($start);
    print("Unsolvable position.");
}

print("Total positions checked: ", $map->{callcount});