http://qs1969.pair.com?node_id=802084


in reply to A Semi-automatic word search solver

Sorry about the massive delay in finishing and uploading the revised version, University work and finding a place to live next year caught up with me.

Description:

The major update to the program is the use of an external file to load the puzzle to be searched, in addition to this many of the improvements suggested in the other comments have been included. An additional change is the ability to load a puzzle file from inside the program and to access internal help from the program.

Interface:

The interface remains essentially the same as before, with only the addition of several new commands outlined below:
#help - displays the list of internal commands and what they do<
#newpuzzle FILENAME - loads a new puzzle from the file
#quit - Same as in the previous version.

In addition, the program now accepts arguments from the command line, the most important of these (and the only required one) is -f to load the file to be searched.

Note: if this is forgotten, the program will prompt the user to supply a file.

Planned Improvements:

1.) Moving the help data over to POD as suggested in the Getopt::Long documentation,

2.) Allowing the program to remember the location of previously searched for words, to cut down on search time (possibly using Memoization),

3.) Allowing the user to supply a list of the words in the word search, possibly combining this with the puzzle data file

Program Code:

#!/usr/bin/perl # wordSearchSolve.pl # Program to solve a word search puzzle semi-automatically. # # With thanks to toolic, Limbic~Region and Count Zero of perlmonks.org + for # suggesting several improvements. # # Christopher Dykes (2009-10-19) - (v2.2) #Enable the following packages: use strict; #Enable strict syntax checking use warnings; #Enable diagnostic warnings use Getopt::Long; #Enable command line option parsing #Define constants: use constant 'VERSION' => 2.2; #Declare local variables: my($i, $j, $k, $word, $found); #Various control variables my $done = 0; #Whether we're finished or not my(@start, @end); #The start and end locations of the word my @puzzle; #The puzzle to be searched #Parse command line options: my($file, $help, $version); #Available command line options GetOptions('file=s' => \$file, 'help' => \$help, 'version' => \$versio +n); &help if($help); #Display the help message &version if($version); #Display the version details @puzzle = @{&puzzleGet($file)} if($file); #Open our file if we h +ave one exit if($help || $version); if(!$file) #Get a file from the user if they haven't supplied one { my $check = " "; while($check ne "y") { print "WARNING: No File supplied, supply now? (y/n) "; $check = lc(<STDIN>); chomp $check; exit if($check eq "n"); } print "Enter file name:\t"; $file = <STDIN>; @puzzle = @{&puzzleGet($file)}; } #Display the header: print "Wordsearch Solver (v", VERSION, "):\n\n"; print "Enter the term to search for, enter '#quit' to exit "; print "and #help for assistance\n\n"; #Allow the user to search: while(!$done) { print "> "; chomp($word = <STDIN>); #Get the word from the u +ser my @chars = split(//, $word); my @words = split(/ /, $word); if($chars[0] eq "#") { $done++ if($word eq "#quit"); &internalHelp if($word eq "#help"); if($words[0] eq "#newpuzzle") { @puzzle = @{&getPuzzle($words[1])}; } } else { print $word, "\t= "; my @word = split(//, $word); for($i = 0, $found = 0; $i < @puzzle && !$found; $i++) #Row + loop { for($j = 0; $j < @puzzle && !$found; $j++) #Col loop { for($k = 0; $k < 8 && !$found; $k++) #Dir loop { my @gen = (""); $found = &search($k, $i, $j, \@puzzle, \@word, @ge +n); } } } print "($i,$j) - ($end[0],$end[1])\n" if($found); print "NO RESULT\n" if(!$found); } } #Subroutines begin here: sub search #Performs a recursive search across the puzzle { #Declare local variables: my($dir, $row, $col, $puzRef, $wrdRef, @gen) = @_; my @puzzle = @{$puzRef}; my @word = @{$wrdRef}; ($end[0], $end[1]) = (($row + 1), ($col + 1)); #Set our end loc +ation return 0 if($puzzle[$row][$col] ne $word[$#gen]); return 1 if($#word == $#gen); #Decide what to do: $row++ if(($dir == 0 || $dir == 4 || $dir == 5) && $row < $#puzzle +); $row-- if(($dir == 1 || $dir == 6 || $dir == 7) && $row > 0); $col++ if(($dir == 3 || $dir == 5 || $dir == 7) && $col < $#puzzle +); $col-- if(($dir == 2 || $dir == 4 || $dir == 6) && $col > 0); #Do the useful stuff: push(@gen, $puzzle[$row][$col]); return 1 if(&search($dir, $row, $col, \@puzzle, \@word, @gen)) || +return 0; } sub puzzleGet { my @puzzle; open(FILEIN, "$_[0]") || die("Couldn't open file $_[0]"); while(<FILEIN>) { chomp($_); my @line = split(/ /, $_); push(@puzzle, \@line); } return \@puzzle; } sub help { print "Usage: wordSearchSolve.pl [OPTION] -f [FILENAME]\n"; print "A program to solve a word search automatically\n\n"; print "-f\t--file\t\tLoad the puzzle from this file\n"; print "-h\t--help\t\tDisplay this message\n"; print "-v\t--version\tDisplay version information\n\n"; print "Report bugs to <dykes.chris\@gmail.com>.\n"; } sub version { print "wordSearchSolve (v", VERSION, ")\n"; print "Copyright (C) 2009 Christopher Dykes.\n"; print "License GPLv3+: GNU GPL Version 3 or later <http://gnu.org/ +licenses/gpl.html>\n"; print "This is free software: you are free to change and redistrib +ute it.\n"; print "There is NO WARRANTY, to the extent permitted by law.\n\n"; print "Written by Christopher Dykes.\n"; print "With thanks to toolic, Limbic~Region and Count Zero of perl +monks.org\n"; print "for suggesting several improvements.\n"; } sub internalHelp { print "\nAvailable commands are:\n"; print "\t#help\t\tDisplay this message\n"; print "\t#newpuzzle\tLoad a new puzzle from a file\n"; print "\t#quit\t\tExit the program\n"; print "\n"; }

The puzzle data file:

This can be any plain text file laid out like the one below:

r e l a e d b y e s c r e e n t m i o e i s h l i s l a t e r a t n u r c n n u r g m u a i h s o u b m t h a a m e o a n c c c
I.e. a space between each column, and a newline between each row.
NB: make sure there are no trailing new lines in the file.