Showing posts with label perlmonks. Show all posts
Showing posts with label perlmonks. Show all posts

Tuesday, 20 October 2009

Updated word-search solver in perl

 I've been busy, updating my word search solver that I wrote about a month ago now, and have managed to make several improvements.  Once again I've uploaded the code to perlmonks, but this time I've also posted it here (finally figured out that block quote will work nicely in laying out code).  In essence the code remains the same, with just a few added features, including:
  • The puzzle is now loaded from a text file (an example is given below).
  • The program now accepts command line arguments to give help, version information and to select the file to use.
  • A slightly greater list of internal commands, for a full list type #help at the programs prompt.
An example of a Puzzle file:
In order to actually use the program now, you have to supply it with a file containing the puzzle to be searched.  This is simple to set out, each letter of the puzzle is put in the file with a single space between columns and a new line between rows (see the example 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
The program expects you to supply a file from the command line (using the -f switch) when you start, but will prompt you for one if you forget it.

The Program itself:
#!/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' => \$version);

&help    if($help); #Display the help message
&version   if($version); #Display the version details
@puzzle = @{&puzzleGet($file)} if($file); #Open our file if we have 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();
  chomp $check;
  
  exit if($check eq "n");
 }
 print "Enter file name:\t"; $file = ;
 @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 = ); #Get the word from the user
 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, @gen);
    }
   }
  }
  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 location

 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()
 {
  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 .\n";
}
sub version
{
 print "wordSearchSolve (v", VERSION, ")\n";
 print "Copyright (C) 2009 Christopher Dykes.\n";
 print "License GPLv3+: GNU GPL Version 3 or later \n";
 print "This is free software: you are free to change and redistribute 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 perlmonks.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";
}
download here

Friday, 25 September 2009

Doing some AI stuff in Perl

So, I've written a semi-automated Word Search Solver in perl over the last couple of days, I haven't uploaded the code to here, because I haven't found an adequate way of formatting the code yet (I sense another project coming up), but the post link should send you to the page on perlmonks where I uploaded to the post too, all of the details are there, but for completeness sake and to tantalize you into going there, I'm going to post the details here:

Description:
The code below is for a semi-automatic word search solver, that uses a recursive function to search a multi-dimension array containing the puzzle for the word that the user asks for.

The program is semi-autonomous, in that the search itself is carried out automatically, but the puzzle is (for the moment) hard-coded, and the user must enter each word that they want to search for one-by-one.

Interface:The interface is a simplistic text-based one, the user enters the word that they want to search for, and the program responds with a set of coordinates for the start and end positions of the word being searched for, or 'NO RESULT' if the word can't be found.
The only command available to the user apart from the search ability is the '#quit' command which exits the program.

Considerations: The program relies on the assumption that the dimensions of the grid to be searched are equivalent, i.e. rows == cols

Planned Improvements:
  1. The option for the user to enter in the puzzle data 'on the fly'
  2. Removal of the final global variable '@end'
  3. The ability for the user to define a list of values to search for
If that doesn't peak your interest then this probably isn't the sort of thing for you, but if you're interested in AI search techniques, solving word searches, variable references, or how to do any of the previous in perl, check it out.