My kids came home with little puzzles from a party -- you know the ones -- there's a picture on a series of 15 tiles in a 4 x 4 square with one empty space. You slide around the tiles to scramble or solve the puzzle. The trouble is, it doesn't take much to scramble even these small puzzles beyond solving easily. I said, "This is a job for Super-Perl." Here's the result. (Perl 4 warning...)

# perl script to solve a sliding tile puzzle
# I'm doing 4 x 4 but same should work for other sizes if
# there's enough memory -- you need to change sub kids to
# return possible moves for your size

# Solution is _0123456789abcde which represents
#  _ 0 1 2
#  3 4 5 6
#  7 8 9 a
#  b c d e
# in this configuration 0 or 3 can swap with _

# actually tiles can be named how you like, but _ is the gap

# you put in the desired configuration in $target
# (or visa-versa)

$solution='_0123456789abcde';
#$target='015234_6789abcde';

srand(time); for(0..50) { rand();}
$target=&rnd(40,$solution) unless $target;  # random for testing
print "Target is $target\n";

(%s)=($solution,''); # %s is kids/grandkids... of solution
(%t)=($target,'');   # %t is kids/grandkids... of target
@ws=($solution);     # workque for solution
@wt=($target);       # workque for target
$level=1;

while(1) {
 print "$level \r"; $level++;
 for $a (@ws) {      # for each in workque
  for(&kids($a)) {   # find kids
   next if defined($s{$_});    # skip if already done
   push(@ws2,$_);    # add to workque
   $s{$_}=$a;        # add to history & associate with parent
   &done($_) if defined($t{$_});  # check if we found a solution
  }
 }
 for $a (@wt) {
  for(&kids($a)) {
   next if defined($t{$_});
   push(@wt2,$_);
   $t{$_}=$a;
   &done($_) if defined($s{$_});
  }
 }
 @ws=@ws2; undef @ws2; # move new workque to old and clear for next ti
+me
 @wt=@wt2; undef @wt2;
}

sub kids {
 # return a list of all possible moves from this configuration
 local($_,@r);
 $_=$_[0]; push(@r,$_) if !/^...(_|..._)/ && s/(.)_/_$1/;
 $_=$_[0]; push(@r,$_) if !/^..(_|..._)/ && s/_(.)/$1_/;
 $_=$_[0]; push(@r,$_) if s/(.)(...)_/_$2$1/;
 $_=$_[0]; push(@r,$_) if s/_(...)(.)/$2$1_/;
 return @r;
}

sub done {
 # we're done -- print result
 @r=@_;
 print "$level: done $_[0]\n";

 # backwards from solution
 for($a=$s{$_[0]}; defined($s{$a}); $a=$s{$a}) { push(@r,$a);}

 # forward from target
 for($a=$t{$_[0]}; defined($t{$a}); $a=$t{$a}) { unshift(@r,$a);}

 # dump results
 print join("\n",@r),"\n";
 exit;
}

# execute $_[0] random moves on $_[1]
sub rnd { $_[0] < 1? $_[1]: &rnd($_[0]-1, &r(&kids($_[1]))); }

# return a random element from the list
sub r { $_[($#_+1) * rand()];}

[download]
Enjoy

john

In reply to Sliding Tile Puzzle Solver by jhanna

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.