Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) 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 +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;

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!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (9)
    As of 2014-09-18 07:02 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How do you remember the number of days in each month?











      Results (108 votes), past polls