Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Shuttle Puzzle solver

by jima (Vicar)
on Sep 25, 2007 at 02:10 UTC ( #640852=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info
Description: I was perusing back issues of Creative Computing at the library and ran across some problem sets from computer programming contests that were held in the late 1970s and early 1980s. Being a past participant and winner of programming contests, I checked out the problem sets, just to see what kids were expected to solve 20+ years ago. One of the puzzles that they had to solve was the Shuttle Puzzle, in which you have to switch two groups of marbles on a board. When the problem was presented in the contest, it came with a big hint to help the kids to figure out how to solve the puzzle. This Perl Tk demo program is a result of my work on that puzzle.
#
#   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;

Comment on Shuttle Puzzle solver
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://640852]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (10)
As of 2014-08-28 00:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (254 votes), past polls