#
# shuttle.pl -- a program that solves the "Shuttle Puzzle", a classi
+c problem
# found in mechanical puzzle catalogs, Computer Science classes and th
+e
# occasional programming contest.
#
# Quick puzzle description: You start with a board with 7 holes. There
+ are
# 3 black and 3 white marbles on the board in this configuration:
#
# W W W . B B B
#
# The object is to switch the positions of the black and white marbles
+. You
# have only two moves available. You can either move a marble 1 space
+(into
# the empty position) or jump a marble over 1 and only 1 marble of the
# opposite color (again, into the empty position). You cannot jump mar
+bles
# over more than 1 position, and you cannot backtrack your moves.
#
# This program was inspired by the inclusion of this puzzle in a progr
+amming
# contest at the University of Wisconsin-Parkside in May of 1981. The
+problem
# set from this contest was published in Creative Computer magazine (O
+ctober
# 1981, p. 148), and included the following hint:
#
#
# HINT: First figure out how to solve the puzzle. Next, observe the
# movement of the empty space. Finally find the rules that govern the
+movement
# of the hole to the left and right and program the computer to carry
+them out.
#
#
# Since this hint points to a short, non-intuitive algorithm that work
+s for all
# sizes of boards, I felt the need to demonstrate the correctness of t
+he
# algorithm in a colorful and interactive manner.
use Tk;
use strict;
use constant {
PI => 3.14159265, # used in sine/cosine functions
ANIMITER => 20, # number of steps in the marble jump (should b
+e 1 or greater)
};
my($marbles) = 3; # number of marbles per side
my(@moves) = (); # an array that holds the list of moves
my($total_moves, # the total number of moves required to switch
+ the current board
$move_ptr, # pointer into @moves
$hole, # index of the current location of the hole
$iter); # animation iter
my($pause) = 23; # pause between marble moves
my($col1) = 'red'; # marble colors
my($col2) = 'blue';
my($mw,$c,@marbles); # Tk object variables
my($but,$plusbut,$minusbut);
# generate_moves: creates the list of moves needed to solve the board
sub generate_moves {
my($one,$two) = @_;
my($lo,$hi);
$total_moves = (($marbles + 1) * ($marbles + 1)) - 1;
@moves = ();
# Yes, this is the entire solution algorithm.
$one = -1;
$two = 2;
$lo = 1; $hi = $total_moves;
for my $x (1 .. $marbles) {
$moves[$lo++] = $moves[$hi--] = $one;
$moves[$lo++] = $moves[$hi--] = $two for 1 .. $x;
$one *= -1; $two *= -1;
}
$move_ptr = 1; # reset the pointer to the first move
$hole = $marbles; # the hole starts in the middle of the board
$iter = 0; # reset animation iter
}
sub loop {
my($xmul, # the number of x pixels a marble should be mo
+ved
$ymul, # the number of y pixels a marble should be mo
+ved
$xsign); # left or right? + or -?
$xmul = (abs($moves[$move_ptr]) == 2 ? 50 : 25);
$ymul = 50;
$xsign = ($moves[$move_ptr] > 0 ? -1 : 1);
$c->move($marbles[$hole + $moves[$move_ptr]],
$xsign * $xmul * (cos($iter * PI / ANIMITER) - cos(($iter + 1)
+ * PI / ANIMITER)),
$ymul * (sin($iter * PI / ANIMITER) - sin(($iter + 1) * PI / A
+NIMITER)),
);
++$iter;
if ($iter < ANIMITER) { # still some animation to do for this
+marble
$mw->after($pause, \&loop);
} else { # done with this marble
# move the marble item from its old position into the hole.
$marbles[$hole] = $marbles[$hole + $moves[$move_ptr]];
$hole += $moves[$move_ptr];
$marbles[$hole] = '';
++$move_ptr; # move to the next marble move
if ($move_ptr <= $total_moves) { # more moves?
$iter = 0;
$mw->after($pause, \&loop);
} else { # no more moves, we're done.
$but->configure(-state => 'normal');
$plusbut->configure(-state => 'normal');
$minusbut->configure(-state => 'normal') if $marbles > 1;
}
}
}
sub start {
generate_moves();
# weird stuff happens if you press the buttons again in the middle
+ of a run
$but->configure(-state => 'disabled');
$plusbut->configure(-state => 'disabled');
$minusbut->configure(-state => 'disabled');
$mw->after($pause, \&loop);
}
sub init_display {
if ($but eq '') { # no need to re-insert the controls if they're
+already in the MainWindow
$but = $mw->Button(
-text => ' Exchange ',
-command => \&start,
-font => 'Courier 12 bold',
)->pack(-expand => 1, -side => 'left', -fill => 'both');
$mw->Scale(
-orient => 'horizontal',
-from => 3,
-to => 100,
-variable => \$pause,
-label => "delay (in msec)",
)->pack(-side => 'left');
$minusbut = $mw->Button(
-text => ' - ',
-command => sub { if ($marbles > 1) { --$marbles; init_dis
+play(); $minusbut->configure(-state => 'disabled') if $marbles == 1;}
+ },
)->pack(-expand => 1, -side => 'right', -fill => 'both');
$plusbut = $mw->Button(
-text => ' + ',
-command => sub { ++$marbles; init_display(); $minusbut->c
+onfigure(-state => 'normal'); },
)->pack(-expand => 1, -side => 'right', -fill => 'both');
}
$c->destroy if Tk::Exists($c);
$c = $mw->Canvas(
-width => 130 + 50 * (2 * $marbles + 1),
-height => 200,
-background => 'black',
)->pack(-side => 'top', -before => $but);
@marbles = ();
for (1 .. $marbles) {
my($m) = $c->createOval(30 + $_ * 50, 100, 60 + $_ * 50, 130,
+-fill => $col1);
push @marbles, $m;
}
push @marbles, '';
for (1 .. $marbles) {
my($m) = $c->createOval(50 * ($marbles + 1) + 30 + $_ * 50, 10
+0, 50 * ($marbles + 1) + 60 + $_ * 50, 130, -fill => $col2);
push @marbles, $m;
}
$c->createRectangle(60,115, 80 + 50 * (2 * $marbles + 1), 150, -fi
+ll => 'brown');
}
##
## main code
##
$mw = MainWindow->new;
init_display();
MainLoop;
|