The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# This script was featured in the article:
# http://www.perl.com/pub/a/2003/11/17/lmsolve.html

package Jumping::Cards;

use strict;

use Games::LMSolve::Base;

use vars qw(@ISA);

@ISA=qw(Games::LMSolve::Base);

sub input_board
{
    my $self = shift;

    my $filename = shift;

    return [ 1 .. 8 ];
}

# A function that accepts the expanded state (as an array ref)
# and returns an atom that represents it.
sub pack_state
{
    my $self = shift;
    my $state_vector = shift;
    return join(",", @$state_vector);
}

# A function that accepts an atom that represents a state
# and returns an array ref that represents it.
sub unpack_state
{
    my $self = shift;
    my $state = shift;
    return [ split(/,/, $state) ];
}

# Accept an atom that represents a state and output a
# user-readable string that describes it.
sub display_state
{
    my $self = shift;
    my $state = shift;
    return $state;
}

sub check_if_final_state
{
    my $self = shift;

    my $coords = shift;
    return join(",", @$coords) eq "8,7,6,5,4,3,2,1";
}

# This function enumerates the moves accessible to the state.
# If it returns a move, it still does not mean that it is a valid
# one. I.e: it is possible that it is illegal to perform it.
sub enumerate_moves
{
    my $self = shift;

    my $state = shift;

    my (@moves);
    for my $i (0 .. 6)
    {
        for my $j (($i+1) .. 7)
        {
            my @new = @$state;
            @new[$i,$j]=@new[$j,$i];
            my $is_ok = 1;
            for my $t (0 .. 6)
            {
                if (abs($new[$t]-$new[$t+1]) > 3)
                {
                    $is_ok = 0;
                    last;
                }
            }
            if ($is_ok)
            {
                push @moves, [$i,$j];
            }
        }
    }
    return @moves;
}

# This function accepts a state and a move. It tries to perform the
# move on the state. If it is succesful, it returns the new state.
#
# Else, it returns undef to indicate that the move is not possible.
sub perform_move
{
    my $self = shift;

    my $state = shift;
    my $m = shift;

    my @new = @$state;

    my ($i,$j) = @$m;
    @new[$i,$j]=@new[$j,$i];
    return \@new;
}

sub render_move
{
    my $self = shift;

    my $move = shift;

    if (defined($move))
    {
        return join(" <=> ", @$move);
    }
    else
    {
        return "";
    }
}

package main;

my $solver = Jumping::Cards->new();
$solver->main();