Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Word Search Builder

by pbeckingham (Parson)
on Feb 21, 2005 at 06:24 UTC ( #432967=CUFP: print w/ replies, xml ) Need Help??

This is a word search program I wrote to generate word search grids interactively, which I then print out and give to my daughter, who loves them.

#! /usr/bin/perl ###################################################################### +## ## Program: wordsearch ## Description: Interactively queries the user for words to add, then ## adds and displays the modified grid. On completion, ## displays the grid and list of words within. ###################################################################### +## use strict; use warnings; use Getopt::Long; my $help; my $width = 20; my $height = 20; GetOptions ("help" => \$help, "width=i" => \$width, "height=i" => \$height); if ($help) { print <<EOHELP; Usage: ws [-width W] [-height H] [-help] EOHELP exit 1; } # Orientations are thus: # 7 0 1 # \ | / # 6 --.-- 2 # / | \ # 5 4 3 my @xdelta = (0, 1, 1, 1, 0, -1, -1, -1); my @ydelta = (-1, -1, 0, 1, 1, 1, 0, -1); # Initialize the grid. my @grid; my @words; initializeGrid (\@grid, $width, $height); displayGrid (\@grid); $| = 1; srand (time); my $command = ''; while (1) { $command = getCommand (); last if $command eq 'quit'; if ($command eq 'finish') { fillGapsInGrid (\@grid, $width, $height); displayGrid (\@grid); displayWords (\@words); last; } if ($command eq 'help' || $command eq '?') { print <<EOHELP; The folllowing commands are supported: add <word> adds the word to the grid, if possible help displays this message ? displays this message finish fills in the remains of the grid, prints out grid and wo +rds quit quits program EOHELP next; } my ($words) = $command =~ /^add (.+)$/; for my $word (split /\s+/, $words) { if (addWord (\@grid, $word)) { push @words, $word; displayGrid (\@grid); } else { print "Could not add '$word'\n"; } } } exit 0; ###################################################################### +## sub initializeGrid { my ($grid, $width, $height) = @_; for my $r (0 .. $height - 1) { $grid->[$r] = '.' x $width; } } ###################################################################### +## sub fillGapsInGrid { my ($grid, $width, $height) = @_; my @alphabet = ('a' .. 'z'); $_ =~ s/\./$alphabet[rand (26)]/eg for @$grid; } ###################################################################### +## sub displayGrid { my ($grid) = @_; print "\n"; for (@$grid) { my $row = $_; $row =~ s/(.)/ $1/g; print $row, "\n"; } print "\n"; } ###################################################################### +## sub displayWords { my ($words) = @_; print "\n", join (', ', @$words), "\n";; } ###################################################################### +## sub getCommand { my $input = ''; while (1) { print "> "; $input = lc <>; chomp $input; return $input if $input =~ /^(?:quit|finish|help|\?|add .+)$/; print "Command '$input' not recognized\n" if $input; } } ###################################################################### +## sub addWord { my ($grid, $word) = @_; # The random algorithm. for (0 .. $width * $height * 8) { my $x = int rand $width; my $y = int rand $height; my $dir = int rand 8; if (wordFits ($grid, $word, $x, $y, $dir)) { insertWord ($grid, $word, $x, $y, $dir); return 1; } } # The exhaustive algorithm. for my $dir (0 .. 7) { for my $y (0 .. $height - 1) { for my $x (0 .. $width - 1) { if (wordFits ($grid, $word, $x, $y, $dir)) { insertWord ($grid, $word, $x, $y, $dir); return 1; } } } } return 0; } ###################################################################### +## sub wordFits { my ($grid, $word, $x, $y, $dir) = @_; #print "testing $word at [$x,$y] dir $dir\n"; my $xi = $xdelta[$dir]; my $yi = $ydelta[$dir]; # Simple rejection based on length. my $endx = $x + (length ($word) - 1) * $xi; my $endy = $y + (length ($word) - 1) * $yi; return 0 if $endx >= $width || $endx < 0 || $endy >= $height || $endy < 0; for my $i (0 .. length ($word) - 1) { my $x0 = $x + ($i * $xi); my $y0 = $y + ($i * $yi); #print "looking for " . substr ($word, $i, 1) . " at $x0,$y0\n"; return 0 if substr ($grid->[$y0], $x0, 1) ne '.' && substr ($grid->[$y0], $x0, 1) ne substr ($word, $i, 1) +; } return 1; } ###################################################################### +## sub insertWord { my ($grid, $word, $x, $y, $dir) = @_; my $xi = $xdelta[$dir]; my $yi = $ydelta[$dir]; for my $i (0 .. length ($word) - 1) { my $x0 = $x + ($i * $xi); my $y0 = $y + ($i * $yi); my $row = $grid->[$y0]; $row = substr ($row, 0, $x0) . substr ($word, $i, 1) . substr ($row, $x0 + 1, length ($row) - $x0 - 1); $grid->[$y0] = $row; } } ###################################################################### +##



pbeckingham - typist, perishable vertebrate.

Comment on Word Search Builder
Download Code
Re: Word Search Builder
by Jaap (Curate) on Feb 21, 2005 at 10:07 UTC
    Ok i had to run it to get it, but what this thing does is create grids like this:
    l a r r y r l l a w e i e h o p a k b v m t m h f
    where you can find words (tail, perl, larry, wall, bell) you entered (interactively). Quite well made.
Re: Word Search Builder
by Anonymous Monk on Feb 21, 2005 at 21:42 UTC

    This is so cool! Thanks you so very much for putting this up. My children will love this. This is one of those things I keep saying I want to do, but for one reason or another never have had time to do right.

    Do you mind if I put this up on a private website for their webring of friends (it is https and password protected, so not generally accessable)? I think their friends would like this also.

      You may do with this as you wish.



      pbeckingham - typist, perishable vertebrate.
Re: Word Search Builder
by Anonymous Monk on Feb 21, 2005 at 22:21 UTC
Re: Word Search Builder
by Fendaria (Beadle) on Feb 21, 2005 at 23:11 UTC

    Wonderful little program.

    I couldn't help myself from noticing though you can combine your two loops in addWord if you randomize the order you brute force search. As long as your brute force search hits all possibilities, you can search in whatever order you want.

    sub randomizeArray(@) { my @array = @_; for my $i ( 1 .. $#array ) { my $j = int rand( $i + 1 ); ( $array[$i], $array[$j] ) = ( $array[$j], $array[$i] ); } return @array; } ## end sub randomizeArray(@) sub addWord { my ( $grid, $word ) = @_; for my $dir ( randomizeArray( 0 .. 7 ) ) { for my $y ( randomizeArray( 0 .. $height - 1 ) ) { for my $x ( randomizeArray( 0 .. $width - 1 ) ) { if ( wordFits( $grid, $word, $x, $y, $dir ) ) { insertWord( $grid, $word, $x, $y, $dir ); return 1; } } } ## end for my $y ( randomizeArray... } ## end for my $dir ( randomizeArray... return 0; } ## end sub addWord

    It would also be neat if you allowed for 'turns' when adding a word. ex. in a 2,2 grid allow the word 'perl' as

    pe
    rl
    

    I think the game 'boggle' allows for word grids in this style.

    Fendaria
      You're insane! Just as nuts as my girlfriend's flatmate who loves borderless jigsaws that come with extra pieces!

      Thanks! You're right about the ordering. As for the Boggle thing, I don't know how I might go about that.



      pbeckingham - typist, perishable vertebrate.
Re: Word Search Builder
by halley (Prior) on Feb 22, 2005 at 17:48 UTC

    An interesting sub-problem is to find the smallest possible grid that fits all of the given words.

    A naive method would just try over and over at a given size until it hit some threshold: if a thousand attempts can't fit all ten words into the grid, then increase the grid slightly and go over it again. Maybe that's good enough.

    The layout of crosswords are a similar problem, except that (1) words are either ACROSS or DOWN, (2) there must be a dead space between two words in the same row or column, and (3) extra letters or nonsense words made from the intersecting direction are not allowed; a dictionary can be consulted to see if intersecting words are actually real words. Often, the dead spaces are dictated beforehand, to arrange them attractively.

    --
    [ e d @ h a l l e y . c c ]

      It all seems to hinge on the random placement of the first few words. After that, it jams them in wherever it can. But those first few make all the difference.

      A challenging crossword algorithm would be one that randomly places a word, then the necessary dead spaces, then replicates the dead space according to some rule of symmetry, ultimately resulting in an "attractive" layout.



      pbeckingham - typist, perishable vertebrate.
Re: Word Search Builder
by wolfger (Deacon) on Feb 23, 2005 at 20:23 UTC

    i q o x e z f m j z q c
    q q a x f d h y h h k n
    b i f z u m r h t s n g
    d g n m x g u b c z s e
    d d p j e m y r j p t u
    g x a c j s i k z z a b
    e q v u n k m s y k r f
    d d x j t n q x i c k z
    m y i l p v e c y b f k
    x g k j e w g v m q h w
    q d x d v u w v r v k z
    q y l h h p + + u l x n


    ++


    You might want to accept only letters, though...


    --
    Linux, sci-fi, and Nat Torkington, all at Penguicon 3.0
    perl -e 'print(map(chr,(0x4a,0x41,0x50,0x48,0xa)))'

      Good point. Thanks.



      pbeckingham - typist, perishable vertebrate.
Re: Word Search Builder
by flounder99 (Friar) on Feb 24, 2005 at 23:20 UTC
Re: Word Search Builder
by RolandGunslinger (Curate) on Feb 25, 2005 at 14:29 UTC
    This is pretty sweet. I had started tinkering with the idea of doing this myself, but didn't get very far. The only other things I would do with this script is make it possible to produce a PDF including some kind of image along with the grid and list of words.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (14)
As of 2014-12-19 08:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

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





    Results (75 votes), past polls