Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

(Golf) The Perl Boggles

by Masem (Monsignor)
on Feb 26, 2002 at 04:55 UTC ( #147481=perlmeditation: print w/replies, xml ) Need Help??

Boggle's a very simple game, in which 16 dice containing random letter sets are rattled and set into a 4x4 grid. Then players have a limited amount of time to located words in the grid by starting at any letter then moving to an adjacent cube (all 8 directions, no 'warping' on sides, however) to form out a word. For example, with the random grid:
You can form the word 'WATER', but you can't form the word 'SETTER' as you can't stay on a letter to make a double letter. At the end of a specified amount of time, the players would reveal their lists and the one with the highest number of valid words wins.

Now, Boggle has been approached before on PM: chipmunk has a basic boggle word finder that locates words in a boggle grid. And gaspodethewonderdog has a node that generates a boggle board.

The golf now is to try to 'simplify' these. Your code should fit into the following blocks:

sub find_boggle_words { $storage = prepare_boggle_search( @bogglelist ); @matched = grep { test_boggle_word( $_, $storage ) } @$dict; return @matched; } sub prepare_boggle_search { # YOUR CODE HERE } sub test_boggle_word { # YOUR CODE HERE }
$dict is a list of valid dictionary words. @bogglelist is an array of the current randomly-selected boggle characters; if the above example was used, then @bogglelist would look like: qw( R E W E M T A S K L E T N V F O ).

The first function, prepare_boggle_search, can be any method to make searching for words easier. If you choose not to use it, treat this function as zero strokes towards your golf total; additionally, you can pass @bogglelist instead of $storage to test_boggle_word (eg test_boggle_word( $_, @bogglelist ). If you do use this function, you should pass back your data structure as this will be passed on to test_boggle_word.

The second function test_boggle_word should return true of the word passed can be found on the boggle board as defined by either @bogglelist or by your $storage variable.

No extra modules are allowed, and strictness need not apply. Golf will only count characters in the subroutines, not in the code provided, and the character count should be done as if the entire code was on one single line. Assume that all inputs are valid (that is, the @bogglelist will always have 16 elements, for example).

For bonus points, generalize the situation when you have a NxN boggle board. In this case, the wrapping code will look like:

sub find_boggle_words { $storage = prepare_boggle_search( $n, @bogglelist ); @matched = grep { test_boggle_word( $_, $n, $storage ) } @$dict; return @matched; }
where $n is the board size N (>1). Again, if you don't use prepare_boggle_search, you can replace $storage with @bogglelist.

Update - You may assume that no word that can be found will be longer than 12 characters, if you need to use this information.

Dr. Michael K. Neylon - || "You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important

Replies are listed 'Best First'.
Re: (Golf) The Perl Boggles
by thelenm (Vicar) on Feb 27, 2002 at 06:18 UTC
    Weighing in at 425 characters. This is my first ever attempt at Perl golf, so I'm not sure how good or bad it is. I won't tell you how long I spent on it. :-)
    sub test_boggle_word { ($w,$n,@b)=@_;for(@b){push@{$h{$_}},$x++}@c=split'',$w;for(@c){return +0if!$h{$_}}@l=map{$h{$_}}@c;$c=-1;$i=-1;my@t;I:while(1){$j=$i+1;$t[$j +]=@t>$j?$t[$j]+1:0;while($t[$j]<@{$l[$j]}){$t=$l[$j][$t[$j]];$a=$t;$b +=$c;($a,$b)=($b,$a)if($a>$b);if($a==-1||($b-$a==1&&$b%$n>0)||($b-$a== +$n-1&&$a%$n>0)||$b-$a==$n||($b-$a==$n+1&&$b%$n>0)){return 1if$i==@l-2 +;++$i;$c=$t;next I}++$t[$j]}--$i;pop@t;lastif$i<-1;$c=$i==-1?-1:$l[$i +][$t[$i]]} }
    I didn't bother using the prepare_boggle_search() function. Also, I wasn't sure if creating extra functions was allowed, so I used iteration rather than recursion (which would have been more natural). This solution also is able to use the same letter more than once, but not consecutively (which was expressly forbidden). I hope that's okay. And for bonus points, it should work for any Boggle board of size NxN.

    It's extremely hard to read all smushed up like that, so here's a little bit nicer version:

    sub test_boggle_word { ($w,$n,@b)=@_; for(@b){push@{$h{$_}},$x++} @c=split'',$w; for(@c){return 0 if!$h{$_}} @l=map{$h{$_}}@c; $c=-1; $i=-1; my@t; I:while(1){ $j=$i+1; $t[$j]=@t>$j?$t[$j]+1:0; while($t[$j]<@{$l[$j]}){ $t=$l[$j][$t[$j]]; $a=$t; $b=$c; ($a,$b)=($b,$a)if($a>$b); if($a==-1||($b-$a==1&&$b%$n>0)||($b-$a==$n-1&&$a%$n>0)|| $b-$a==$n||($b-$a==$n+1&&$b%$n>0)){ return 1 if$i==@l-2; ++$i; $c=$t; next I } ++$t[$j] } --$i; pop@t; last if$i<-1; $c=$i==-1?-1:$l[$i][$t[$i]] } }
    Any thoughts?
Re: (Golf) The Perl Boggles
by chipmunk (Parson) on Mar 02, 2002 at 20:05 UTC
    This golf challenge is tricky, because the design is opposite from how one would usually approach Boggle. Not that this is a bad thing; it makes the challenge more interesting!

    Usually, when playing Boggle, you start with a list of words, and search the grid for all the words in the list. (In real life, the word list is your vocabulary. In a program, it might be /usr/dict or some other word list.) In this golf challenge, you start with the grid, and then you get one word at a time that you try to find, and you can stop searching as soon as you find the word.

    Here's my solution. I went for the bonus points using $n as the board size. It's 195 characters; surely a shorter solution is possible!

    sub test_boggle_word { # 1 2 3 4 5 #2345678901234567890123456789012345678901234567890 my$t;for$y(@n=0..$n-1){$t|=t($y,$_,@_)for@n}sub t{ my($y,$x,$w,$n,@g,$t)=@_;if($y>=0&$y<$n&$x>=0&$x<$ n&chop$w eq splice@g,$y*$n+$x,1,0){for$Y(-1..1){$t |=t($y+$Y,$x+$_,$w,$n,@g)|!$w for-1..1}}$t}$t } # testing code: @bogglelist = qw/ R E W E M T A S K L E T N V F O /; $n = 4; $dict = [ qw/ WATER SETTER VETO WASTE WASTES / ]; print "$_\n" for find_boggle_words(); sub find_boggle_words { # $storage = prepare_boggle_search( $n, @bogglelist ); @matched = grep { test_boggle_word( $_, $n, @bogglelist ) } @$dict; return @matched; }
    In my testing code, WATER, VETO and WASTE can be found in the grid. The original node doesn't specify, but in the rules of Boggle a single cube cannot be used twice in the same word. So, WASTES can't be found because the S would be used twice.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://147481]
Approved by root
NodeReaper reads the Necronomicon

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2017-03-25 22:35 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (313 votes). Check out past polls.