phizel has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to solve word search puzzles which contain hidden messages. The idea is to match the given words in the grid and any remaining letters will be the message. I found this script golfed version [1] to be a good starting point, but it doesn't handle many corner cases, so I tried improving on it by keeping a separate grid for each direction. I ultimately want to duplicate the results from this online tool [2], which produces perfect results, but I can't find a description of the algorithm anywhere. The following is my version, which produces good results, but not perfect.
[1] http://codegolf.stackexchange.com/a/3390/36220
[2] http://www.dcode.fr/word-search-solver

Edit: So I finally got this particular test to work by iterating through the different directions in the reverse order plus only allowing one match per word. That feels a bit arbitrary, so still open to alternative algorithm suggestions. 

#!/usr/bin/env perl
use 5.012;
use warnings;

use List::AllUtils qw(nsort_by reduce);

my $grid = join "\n", qw(
    ONEFISHTWOJELLYFISHS
    LYNTAOBDOPAEPNBUETYE
    PMIRHSAESTNESRRARTEU
    CALIFORNIAPLEASANTLL
    HHSREDPOPPIESXVHUWLB
    AAAZECROFEFILERDLOAE
    PMLMPHSIFDEPIRTSYOVM
    PDLEQMIEWBLACKCATDSI
    YEADENRESURGENCEPYNT
    FNCIDOLBABYOCTOPUSOR
    AHTCYLMAERDSRELLEFTE
    MODEERFOTTHGILFWDPLM
    IUBRNEDRAGEMOHELHKAM
    LSSCOUNTRYWALKDTVQWU
    YEDNOPNEZORFPUSFRUSS
);

my @words = qw(
    BABYOCTOPUS
    BLACKCAT
    CALIFORNIAPLEASANT
    CALLAS
    COUNTRYWALK
    EEL
    FELLERSDREAM
    FLIGHTTOFREEDOM
    FROZENPOND
    HAMDENHOUSE
    HAPPYFAMILY
    HOMEGARDEN
    LIFEFORCE
    ONEFISHTWOJELLYFISH
    PEAPODBOAT
    REDPOPPIES
    REEFDWELLERS
    RESURGENCE
    SEASHRIMP
    STRIPEDFISH
    SUMMERTIMEBLUES
    SURFSUP
    VASE
    WALTONSVALLEY
    WOODY
);

# Look for the largest words first.
@words = nsort_by { -length } @words;

my $width = index $grid, "\n";
my @dir = map { [$_, 0, $grid], [$_, 1, $grid] } (0, $width-1 .. $widt
+h+1);
for my $word (@words) {
    for my $dir (@dir) {
        my @char = split '', $dir->[1] ? reverse $word : $word;
        my $re = join ".{$dir->[0]}", map "($_)", @char;
        if (my $i = $dir->[2] =~ /$re/s ) {
            substr $dir->[2], $-[$i++], 1, ' ' for @char;
        }
    }
}

my $message = reduce { $a & $b } map { $_->[2] } @dir;
$message =~ tr/A-Z//cd;
say $message;

[download]
The hidden message is supposed to be LYNNBUETTNERART, but my version produces LYNNBUETTNRART... (note the missing second E), whereas the the online tool gets this right. Can somebody help find the error in the algorithm or the implementation, or suggest a better algorithm?

Replies are listed 'Best First'.
Re: Improving this word search solver
by Anonymous Monk on Jan 21, 2015 at 01:31 UTC
    I ultimately want to duplicate the results from this online tool, which produces perfect results ... The hidden message is supposed to be LYNNBUETTNERART, but my version produces LYNNBUETTNRART... (note the missing second E), whereas the the online tool gets this right.

    Have you solved the puzzle by hand; are you sure the online tool is getting it "right"? One of your words is "EEL", which happens to appear on the second line, 12th character, down. That's where that "E" between "TN" and "RART" on the third line is probably going. Perhaps your ruleset is different from what the online tool is using. I'm guessing the online tool only matches each word once, and if that's the case, how does it determine which match has priority? Anyway, my suggestion:

    1. Decide on the set of rules used for solving. (Without these specs, it's difficult to give advice on a solution anyway!)
    2. Write many test cases, solving them by hand.
    3. Work on your algorithm until all tests pass.

    Step 2 can get a little annoying, but Step 3 usually makes up for that, that feeling when all your tests pass is great :-)

    Here's a template:

    #!/usr/bin/env perl
use warnings;
use strict;

use Test::More;

is solve("FOO\nBAR\nOOF\n", ['FOO']), 'BAR';
my $INPUT1 = <<'_X_';
BFOO
AQUZ
ROOF
_X_
my @WORDS1 = qw/ FOO BAR /;
is solve($INPUT1, \@WORDS1), 'QUZ';
# more test cases here!

done_testing;

sub solve {
    my ($grid, $words) = @_;
    my $solution = "..."; # your algorithm here!
    return $solution;
}

    [download]
[reply]
[d/l]
      The online tool is correct, especially since it outputs the right hidden message and mine is only close. I have no idea of their algorithm because it's closed source and the only other place I could find a similar algorithm was that codegolf stackexchange link.
[reply]

        I don't see a description of their solver on their website at the moment, and my French is no good... If you really want your solving rules to match the "dCode" version exactly, you'll have to figure them out somehow - ask the people who wrote them, figure them out experimentally, ... in that respect my crystal ball is not any clearer than yours ;-)

        Remember, the "rules" for solving the puzzle are not necessarily the same as an algorithm. The rules will, in English (or French?), say things like "longer words match first", "the search proceeds from left to right, top to bottom", "each word matches only once", "matches across have higher priority than diagonal", etc. Maybe if you ask the people who implemented the solver, they can give you these rules, without revealing their code.

[reply]

Back to Seekers of Perl Wisdom