Unsolved problem + boredom =

#!/usr/bin/perl

# 15 puzzle solver

use strict;
use warnings;

my $start = <<END; # initial layout, 0 for empty cell
14 15  1  2
12  7  6 10
13  3 11  9
 8  4  5  0
END

my @squarestomove = solve( split ' ', $start );

while( @squarestomove > 10 )
  {
  print "steps: @{[ splice @squarestomove, 0, 10 ]}\n";
  }
print "steps: @squarestomove\n";

exit;

sub solve # internally runs in letters, not numbers, for regex purpose
+s
  {
  my (%numbers2letters, %letters2numbers);
  @numbers2letters{ 0..15 } = (' ', 'a'..'o');
  %letters2numbers = reverse %numbers2letters;
  my $board = join '', @numbers2letters{@_};
  $board =~ s/....\K(?=.)/\n/g;
  my $win   = "abcd\nefgh\nijkl\nmno ";
  my $moves = '';

  for my $n (1..18) # place first, then first two, first three, etc.
    {
    (my $path, $board) = solvepart($board, substr $win, 0, $n );
    print "path: $path\n\n$board\n\n";
    $moves .= $path;
    }

  #print "\nmoves: $moves\n";
  1 while $moves =~ s/(.)\1//g; # remove dups
  print "\nmoves: $moves\n\n";

  return @letters2numbers{ split //, $moves};
  }

sub solvepart
  {
  my ($have, $want) = @_;
  my @stack = $have;
  my %seen;
  my $delta = length $have =~ s/\n.*//sr;
  my $count = 0;

  while( $_ = shift @stack )
    {
    $count++;
    if( $count > 1e7 ) # loop protection, may need to be larger
      {
      my $size = keys %seen;
      die "died with $size seen\n";
      }
    my ($path, $board) = /(.*),(.*)/s ? ($1, $2 ) : ('', $_);
    #print "$board\n\n";
    if( $want eq substr $board, 0, length $want)
      {
      return $path, $board;
      }
    elsif( $seen{$board}++ )
      {
      }
    else
      {
      my $new = $board;
      if( $new =~ s/(\w) / $1/ ) # right
        {
        $seen{$new} or push @stack, "$path$1,$new";
        }
      $new = $board;
      if( $new =~ s/ (\w)/$1 / ) # left
        {
        $seen{$new} or push @stack, "$path$1,$new";
        }
      $new = $board;
      if( $new =~ s/(\w)(.{$delta}) / $2$1/s ) # down
        {
        $seen{$new} or push @stack, "$path$1,$new";
        }
      $new = $board;
      if( $new =~ s/ (.{$delta})(\w)/$2$1 /s ) # up
        {
        $seen{$new} or push @stack, "$path$2,$new";
        }
      }
    }
  die "no solution for $_";
  }
[download]

It's just a simple breadth first search looking to position the 1 first, then 1 & 2, then 1 & 2 & 3, etc. Trying to do the whole thing at once was too big for my machine (and maybe any machine :).

There are still some debug prints left on, and some near infinite loop detection code.

Internally I use letters to simplify (and speed up?) the regex for finding moves.

tybalt89 Pure genius!

---

I'm not really a human, but I play one on earth. ..... an animated JAPH

So, you have familiarity on how to programmatically solve the problem?

Ha, no, in fact the "feature inclusive" comment I made was based on my being impressed Discipulus' code actively can figure out things like the minimum number of moves remaining or even that a solution was impossible based on the random shuffle. My college course's 15 puzzle was, I believe, primarily selected by our professor because he wanted us to use a Windows environment and actually take input from mouse clicks and resolve screen position and current board state for what action to take for changing the appearance on the screen (we hadn't done any sort of GUI yet either). It didn't include any such features beyond those goals (and it was still really difficult for all of us in the class at the time).

I sometimes wish I was back in school, studying the matrix math needed to solve that problem

I often have the, "I wish I was back in school," thought too, and then I remember what school was like and being massively in debt, with no spending cash, living on ramen noodles, in a slum apartment I shared with 2-3 other people every semester, beating my brains out over my course load so I could actually finish an engineering degree in 4 years with a good GPA, and I compare that with my relatively awesome life now and I think twice. :-)

Just a few weeks ago I was trying to use some simple matrix math for what's called Cramer's Rule to solve a linear system of equations for a circuit I was analyzing, only to quickly determine I can no longer correctly do the matrix math I was probably capable of early on in high school... so naturally I just used a computer.

Most people get wiser as they age, or so I'm told, I swear I'm getting dumber every year I get further from school.

> being impressed Discipulus' code actively can figure out things like the minimum number of moves remaining or even that a solution was impossible based on the random shuffle.

Oh do not overstimate me, nor my code: I have no idea about the minimum number of moves nor how to solve the puzzle programatically.

The possible/impossible solution is another matter and is a simple one: see the link to the mathworld site in the reference or run with the --verbose switch to see how to compute it.

Infact it is calculated counting, for every tile, how many are lesser of the current one, as if they lay on a single row and adding all these number: if the result is odd the game is impossible.

You can read on wikipedia:

> .. offering a $1,000 prize for anyone who could provide a solution for achieving a particular combination specified by Loyd, namely reversing the 14 and 15. This was impossible, as had been shown over a decade earlier by Johnson & Story (1879), as it required a transformation from an even to an odd combination.

Infact I simply do: $perm += grep {$_ < $appear[$num]} @appear[$num+1..$#appear]; and later on if ($permutation % 2){ print "Impossible game with odd permutations!"

Running with --verbose shows it clearly:

---------------------------------------------------------
Appearence of the board:
[14 15 12 2 10 6 1 7 13 5 9 11 4 3 8 X]
---------------------------------------------------------
current followers                      less than current
---------------------------------------------------------
[14]    15 12 2 10 6 1 7 13 5 9 11 4 3 8           13 +
[15]    12 2 10 6 1 7 13 5 9 11 4 3 8              13 +
[12]    2 10 6 1 7 13 5 9 11 4 3 8                 11 +
[2]     10 6 1 7 13 5 9 11 4 3 8                   1 +
[10]    6 1 7 13 5 9 11 4 3 8                      8 +
[6]     1 7 13 5 9 11 4 3 8                        4 +
[1]     7 13 5 9 11 4 3 8                          0 +
[7]     13 5 9 11 4 3 8                            3 +
[13]    5 9 11 4 3 8                               6 +
[5]     9 11 4 3 8                                 2 +
[9]     11 4 3 8                                   3 +
[11]    4 3 8                                      3 +
[4]     3 8                                        1 +
[3]     8                                          0 =
                                                  ----
MEDIUM game with even permutations                 68
[download]

Being 105 the highest value for permutations I just assign solved, easy, medium and hard difficulty level for permutations with values of 0, 1-35, 36-70 and 71-105

The real fun is running the program with --perl switch... ;=)

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

so naturally I just used a computer.

Only an idiot would want to do matrix equations by hand!! :-)

---

I'm not really a human, but I play one on earth. ..... an animated JAPH