Perl-Sensitive Sunglasses PerlMonks

Comment on

 Need Help??
```#
#   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

\$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;

In reply to Shuttle Puzzle solver by jima

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

• 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.
• Posts may use any of the Perl Monks Approved HTML tags:
a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, 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, 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: & & < < > > [ [ ] ]
• Link using PerlMonks shortcuts! What shortcuts can I use for linking?

Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (4)
As of 2018-04-20 19:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (78 votes). Check out past polls.

Notices?