http://qs321.pair.com?node_id=144795

in reply to Re: sort with fewest moves (Bose-Nelson algorithm)
in thread sort with fewest moves

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