Ok... So the first post actually didn't work. Kids had a serious bug... And truth be told, many puzzles would take forever to solve. So here's one that actually works.

# 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';
$target = shift(@ARGV);

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

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

$stime=time;

$l=70;               # I messed around with this to optimize speed / d
+epth

while(@wt) {
 # give a bit of feedback
 print STDERR "$level \r" unless $level & 127; $level++;
 if( ($a=shift(@wt)) ) {     # next item for workque
  for(&kids($a)) {           # for each of the possible moves from her
+e
   next if defined($t{$_});  # if we've been here before, skip it
   push(@wt,$_);             # add this position to the workque
   $t{$_}=$a;                # remember this configuration & its paren
+t
   $md{$_}=&md($_,$solution); # log the distance for this point to the
+ solution
   &done($_) if $_ eq $solution;
  }
 }
 # once in a while we want to reorder the workque by their distances
 if($level % $l == 1) {
  @wt=(sort bymd @wt)[0 .. 2*$l];
 }
}
print "\nNo solution found.\n";

sub kids {
 # return a list of all possible moves from this configuration
 local($_,@r,$i);
 $i=index($_[0],'_') % 4;
 $_=$_[0]; push(@r,$_) if $i!=0 && s/(.)_/_$1/;
 $_=$_[0]; push(@r,$_) if $i!=3 && 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 STDERR time - $stime," seconds $level tries: done $_[0]\n";

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

 # dump results
 for(@r) { s/(....)/$1 /g; print "$_\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()];}

# return manhattan distance of a to b
sub md { local($a,$b,$r)=@_;
 for(0 .. 15) {
  $i=index($b,substr($a,$_,1))-$_;
  $i=-$i if $i < 0;
  $r+=$i % 4 + int($i/4);
 }
 $r;
}

sub bymd { $md{$a} <=> $md{$b}; }
[download]

enjoy!

---

---

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! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

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:
	&		&
	<		&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.