I don't think sorting networks will work here.
If I remember correctly, (and I'm not certain I
ever really understood them) they're built on the
principle of swaps, and
while you can definitely think of a move as a
swap where one of the items is empty, a sorting
network would suggest solutions that aren't
possible.
For example a if the input was (0,2,1) the solution
you would get is swap(1,2) -- but that's not possible.
in this case only swaps in which one parameter is
currently "0" are valid.
It really sounds like a
Game Playing
problem ... here's a recursive solution that tries
all the "smart" moves and figures out which one leads
to the correct order in the minimal number of moves.
If a "close to
optimal" solution is good enough, then
pick_move could be modified to use
Alpha Beta Pruning
to figure
out which of the "smart" moves looks like it's the
smartest. I would guess a good scoring method would
award one point to for each tape in the correct slot,
and half a point if there's a tape in slot 0. (in
which case something else is empty, and can be filled
directly)
#!/usr/bin/perl -wl
use strict;
sub smart_moves {
my @slots = @{ shift(@_) };
my @from;
my $to;
for (my $i = 0; $i < scalar(@slots); $i++) {
if (0 != $i and 0 == $slots[$slots[$i]]) {
# only one smart move if the home for the tape
# in slot i is empty
return ( [ $i, $slots[$i] ] );
}
if (0 == $slots[$i]) {
$to = $i;
next;
}
# don't move anything that's allready 'home'
push @from, $i unless $i eq $slots[$i];
}
return map { [$_ , $to ] } @from;
}
sub make_move {
# returns the new @slots after the move
my @slots = @{shift(@_)};
my @move = @{shift(@_)};
$slots[$move[1]] = $slots[$move[0]];
$slots[$move[0]] = 0;
return @slots;
}
sub pick_move {
my @slots = @{shift(@_)}; # current configuration
my @history = @{shift(@_)}; # moves made so far
my @moves = smart_moves(\@slots);
return @history if 0 == scalar @moves;
my @best;
foreach (@moves) {
my @s = make_move \@slots, $_;
my @h = @history; # copy it
push @h, $_;
my @result = pick_move(\@s, \@h);
if (0 == scalar(@best) || scalar(@result) <= scalar(@best)) {
@best = @result;
}
}
return @best;
}
my @slots = @ARGV;
my @done = pick_move(\@slots, []);
foreach (@done) {
print join(",", @slots) . "\t$_->[0] => $_->[1]";
@slots = make_move(\@slots,$_);
}
print join(",", @slots)
__END__
laptop:~> monk.pl 0 2 1
0,2,1 2 => 0
1,2,0 1 => 2
1,0,2 0 => 1
0,1,2
laptop:~> monk.pl 0 1 2
0,1,2
laptop:~> monk.pl 0 2 1 4 5 3
0,2,1,4,5,3 5 => 0
3,2,1,4,5,0 4 => 5
3,2,1,4,0,5 3 => 4
3,2,1,0,4,5 2 => 3
3,2,0,1,4,5 1 => 2
3,0,2,1,4,5 3 => 1
3,1,2,0,4,5 0 => 3
0,1,2,3,4,5
laptop:~> monk.pl 0 2 1 7 8 9 5 4 3 6
0,2,1,7,8,9,5,4,3,6 9 => 0
6,2,1,7,8,9,5,4,3,0 5 => 9
6,2,1,7,8,0,5,4,3,9 6 => 5
6,2,1,7,8,5,0,4,3,9 8 => 6
6,2,1,7,8,5,3,4,0,9 4 => 8
6,2,1,7,0,5,3,4,8,9 7 => 4
6,2,1,7,4,5,3,0,8,9 3 => 7
6,2,1,0,4,5,3,7,8,9 6 => 3
6,2,1,3,4,5,0,7,8,9 2 => 6
6,2,0,3,4,5,1,7,8,9 1 => 2
6,0,2,3,4,5,1,7,8,9 6 => 1
6,1,2,3,4,5,0,7,8,9 0 => 6
0,1,2,3,4,5,6,7,8,9
-
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.