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 $_";
}
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.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.