Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

The Original IQ Test

by japhy (Canon)
on Oct 26, 2001 at 17:46 UTC ( #121626=CUFP: 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:??;

Comment on The Original IQ Test
Select or Download Code
Re: The Original IQ Test
by dmmiller2k (Chaplain) on Oct 30, 2001 at 02:05 UTC

    Cool! It's the old Hi-Q game!

    Thanks japhy! Now I have something to do to eat up all those extra CPU cycles while I'm stting around waiting for long-running database-intensive code to complete...

    dmm

    
    You can give a man a fish and feed him for a day ...
    Or, you can teach him to fish and feed him for a lifetime
    
      Cool! It's the old Hi-Q game!

      Actually Hi-Q was a game with 33 holes, 32 pegs. Same concept though. The pattern was this (starting w/the center hole empty):

      o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o o
      I used to actually know the answer to solving this (ending w/one peg in the center) in the fewest number of moves (multiple jumps w/one peg == 1 move).

        Whoops.

        'nuff said. Still cool, though...

        dmm

        
        You can give a man a fish and feed him for a day ...
        Or, you can teach him to fish and feed him for a lifetime
        

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (9)
As of 2014-10-02 12:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (56 votes), past polls