Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Lots of family restaurants have the "peg game" at their tables. You know, 15 holes, 14 pegs, and you have to jump one peg over another into an empty spot. The object is to leave ONE peg remaining. I've done it before, but I've forgotten it. So I had Perl refresh my memory.
#!/usr/bin/perl -w use strict; # $board[$empty_pos]{$jumpable} = $jumper my @board = ( { 1 => 3, 2 => 5, }, { 3 => 6, 4 => 8, }, { 4 => 7, 5 => 9, }, { 1 => 0, 4 => 5, 6 => 10, 7 => 12, }, { 7 => 11, 8 => 13, }, { 2 => 0, 4 => 3, 8 => 12, 9 => 14, }, { 3 => 1, 7 => 8, }, { 4 => 2, 8 => 9, }, { 4 => 1, 7 => 6, }, { 5 => 2, 8 => 7, }, { 6 => 3, 11 => 12, }, { 7 => 4, 12 => 13, }, { 7 => 3, 8 => 5, 11 => 10, 13 => 14, }, { 8 => 4, 12 => 11, }, { 9 => 5, 13 => 12, }, ); # 0 = empty, 1 = peg my @state = (1) x 15; # choosing a blank spot, one by one # we only do five spots, since the board # is made up of three sets of these five spots # merely rotated -- there's no need to do extra work for (0 .. 4) { print "Trying to make ", 1 + $_, " the remaining peg...\n"; $state[$_] = 0; jump(\@state, [], {}, $_); $state[$_] = 1; } sub jump { # state, history, repetitions, original blank spot my ($st, $hist, $rep, $orig) = @_; my $ok = 0; # we don't count permutations of movements # update: sort @$hist => sort map "@$_", @$hist return if $rep->{ join "\n", sort map "@$_", @$hist }++; # for each of the blank positions on the board... for my $pos (grep !$st->[$_], 0 .. $#$st) { # if there are two available pegs (one to jump, one to be jumped). +.. for (grep $st->[$_] && $st->[$board[$pos]{$_}], keys %{ $board[$po +s] }) { # the empty place becomes pegged # and the jumper and jumped become empty $ok = $st->[$pos] = !($st->[$_] = $st->[$board[$pos]{$_}] = 0); # add this event to our history push @$hist, [ 1 + $board[$pos]{$_}, 1 + $pos ]; # and now jump again! (the meat of recursion) jump($st, $hist, $rep, $orig); # after we're done, remove the latest addition to the history pop @$hist; # and set the pegged place to empty again # and the two empty places back to pegged $st->[$pos] = !($st->[$_] = $st->[$board[$pos]{$_}] = 1); } } # if we have ONE peg left, and it's the where the blank spot was # show the history to explain how we got here! print map("$_->[0] to $_->[1]\n", @$hist), "\n" if grep($_, @$st) == 1 and $st->[$orig] == 1; }
You can modify the final statement to figure out how to get 8 pegs remaining with no jumps available:
print map("$_->[0] to $_->[1]\n", @$hist), "\n" if grep($_, @$st) == 8 and !$ok;

_____________________________________________________
Jeff[japhy]Pinyan: Perl, regex, and perl hacker.
s++=END;++y(;-P)}y js++=;shajsj<++y(p-q)}?print:??;


In reply to The Original IQ Test by japhy

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 chilling in the Monastery: (7)
    As of 2014-12-28 15:36 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (182 votes), past polls