Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 taking refuge in the Monastery: (7)
    As of 2015-07-29 10:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (263 votes), past polls