Improve My FaceBook Scramble Solver

[Limbic~Region]

All,
There is a FaceBook app which is really just a Flash game. It is called Scramble and I will do my best to recap the rules. You are presented with a 4x4 or a 5x5 grid of randomly selected letters. You must find as many words inside the grid in 3 minutes as possible. Points are scored based on the number of letters in the word and no points are awarded for words with less than 3 letters. The words are formed by chaining adjacent letters together i.e the next letter must be adjacent to the current. A position in the grid may only be used once in the word chain but after entering the word, the entire grid can be used for the next chain. There is no penalty for words entered not in the game's dictionary.

After scouring the net for word lists, I generated the following two scripts:

# build_db.pl - used to update the word list database

#!/usr/bin/perl
use strict;
use warnings;
use Storable;
my (%dict, %seen);

open(my $fh, '<', 'all_words.txt') or die $!;
while (<$fh>) {
    tr/\r\n//d;
    $_ = lc($_);
    next if /[^a-z]/ || length($_) < 3 || $seen{$_}++;
    eval join '', 'push @{$dict', (map {"{$_}"} split //, $_), "{words
+}}, +'$_';";
}
store \%dict, 'my_dict.db';

# scramble.pl - used to play the game

#!/usr/bin/perl
use strict;
use warnings;
use Storable;
use Win32::GuiTest 'SendKeys';

my $dict = retrieve('my_dict.db');
my @board = split //, $ARGV[0];

my %map;
if (@board == 25) {
    %map = (
        0  => [1, 5, 6],
        1  => [0, 2, 5, 6, 7],
        2  => [1, 3, 6, 7, 8],
        3  => [2, 4, 7, 8, 9],
        4  => [3, 8, 9],
        5  => [0, 1, 6, 10, 11],
        6  => [0, 1, 2, 5, 7, 10, 11, 12],
        7  => [1, 2, 3, 6, 8, 11, 12, 13],
        8  => [2, 3, 4, 7, 9, 12, 13, 14],
        9  => [3, 4, 8, 13, 14],
        10 => [5, 6, 11, 15, 16],
        11 => [5, 6, 7, 10, 12, 15, 16, 17],
        12 => [6, 7, 8, 11, 13, 16, 17, 18],
        13 => [7, 8, 9, 12, 14, 17, 18, 19],
        14 => [8, 9, 13, 18, 19],
        15 => [10, 11, 16, 20, 21],
        16 => [10, 11, 12, 15, 17, 20, 21, 22],
        17 => [11, 12, 13, 16, 18, 21, 22, 23],
        18 => [12, 13, 14, 17, 19, 22, 23, 24],
        19 => [13, 14, 18, 23, 24],
        20 => [15, 16, 21],
        21 => [15, 16, 17, 20, 22],
        22 => [16, 17, 18, 21, 23],
        23 => [17, 18, 19, 22, 24],
        24 => [18, 19, 23]
    );
}
else {
    %map = (
        0  => [1, 4, 5],
        1  => [0, 2, 4, 5, 6],
        2  => [1, 3, 5, 6, 7],
        3  => [2, 6, 7],
        4  => [0, 1, 5, 8, 9],
        5  => [0, 1, 2, 4, 6, 8, 9, 10],
        6  => [1, 2, 3, 5, 7, 9, 10, 11],
        7  => [2, 3, 6, 10, 11],
        8  => [4, 5, 9, 12, 13],
        9  => [4, 5, 6, 8, 10, 12, 13, 14],
        10 => [5, 6, 7, 9, 11, 13, 14, 15],
        11 => [6, 7, 10, 14, 15],
        12 => [8, 9, 13],
        13 => [8, 9, 10, 12, 14],
        14 => [9, 10, 11, 13, 15],
        15 => [10, 11, 14]
    );
}

my %sol;
for my $pos (keys %map) {

    my ($tree, $seen) = ($dict, {});
    my @work = [$tree, $pos, $seen];
    while (@work) {
        my $item = pop @work;
        my ($tree, $node, $seen) = @$item;

        # Can't visit this position again
        my %new_seen = (%$seen, $node => 1);

        # No more words below this depth
        next if ! defined $tree->{$board[$node]};

        my $new_tree = $tree->{$board[$node]};

        # Add words up to this point to the solution list
        @sol{@{$new_tree->{words}}} = () if $new_tree->{words};

        # Add items to the work queue
        for my $pos (@{$map{$node}}) {
            next if $new_seen{$pos};
            push @work, [$new_tree, $pos, \%new_seen];
        }
    }
}
sleep 1;  # Used to change focus to browser window
SendKeys($_ . "~", 17) for sort {length($b) <=> length($a)} keys %sol;

These 30 lines of code produce impressive results. It does run into a few issues:

• It produces words not in the Scramble dictionary
• It doesn't produce words in the Scramble dictionary
• Scramble claims that certain words were not entered that debugging indicates were
• It sometimes runs out of time on boards with large numbers of short words

After the game has ended, a complete list of solutions according to Scramble is provided. If that could be extracted, the first two issues could go away by pruning and augmenting the word list to match over time. Unfortunately, being Flash - I have no idea how to do this. The 3rd issue is a matter of the time delay of the SendKeys function. I can slow it down but then issue 4 is exacerbated (running out of time).

Does anyone have any thoughts on how this can be improved. I think the biggest win would be figuring out how to get the "correct" list out of the Flash application after the game is over but there is likely an obvious solution I am just missing. Your thoughts?

Update: Just clicked on a word to get its definition and saw that they are using the Tournament Word List (TWL) Scrabble dictionary. Hopefully that will alleviate the issues I have been having but I still very much would like your feedback.

Update 2: In a private /msg, a monk mentioned I might want to point out that adjacent means any touching square to include diagonally.

[tilly]

First issue. Why do you have the ability to store multiple words with the exact same characters? That is a complication that can just lead to duplicate solutions. Instead I'd naturally assign to the is_word element. Unless I was clever and assigned the word to the word element.

A stylistic issue. I'd recursively traverse the character to add words. Using eval there is an error-prone sledgehammer. What happens with words that include single quotes? You're trusting your input in a way that I avoid.

One minor note. Instead of a breadth-first search, my natural inclination would be a depth-first recursive search, and then I could do a local $seen{$pos} = 1; to mark a node seen. That's not better or worse than what you did, just different. But it does get rid of the queue management. Here is untested code to show you what that bit could look like (note that I am assuming the cleverness of putting the actual word in the word slot):

for my $pos (keys %map) {
   add_solutions($pos, $dict);
}

my %seen;
sub add_solutions {
    my ($node, $tree) = @_;

    local $seen{$node} = 1;
    my $char = $board{$node};
    $tree = $tree->{$char} or return;

    push @solutions, $tree->{word} if $tree->{word};

    for my $new_node (grep not $seen{$_}, @{$map{$node}}) {
        add_solutions($new_node, $tree);
    }
}

[Limbic~Region]

tilly,
Thank you for your feedback. You ask a number of questions and the answer to them is almost all of them is the same. I was lazy and in a hurry.

Why do you have the ability to store multiple words with the exact same characters?

Primarily because I was lazy and copied my own code from Re^3: One for the weekend: challenge. There it made sense and here it doesn't. While it is a cardinal sin to assume your input will be what you expect, the %seen hash should prevent duplicate solutions.

A stylistic issue. I'd recursively traverse the character to add words. Using eval there is an error-prone sledgehammer. What happens with words that include single quotes? You're trusting your input in a way that I avoid.

Well, we have had this conversation in the past. My brain just doesn't seem to think recursively without a lot of effort on my part. Even if I hadn't borrowed from a previous solution and avoided the evil eval, I still would have iterated. Regarding the evil eval sledgehammer: Any word containing anything other than lower case chars is skipped but I realize that it makes the code fragile and prone to breaking if requirements change. The real reason is laziness again. In the original solution, as with this solution, runtime speed was an issue and it took longer without the evil eval. In this case it is a moot point because build_db.pl runs independently of the main program so speed was not a factor and could have been avoided.

One minor note. Instead of a breadth-first search, my natural inclination would be a depth-first recursive search...

Yes, but my natural inclination is to avoid anything recursive with a very long pole. I have done a DFS iteratively and it is ugly. I was more interested in the results than in maintainable robust code. I spent far more time trying to compile a word list than the few minutes it took me to update a previous solution.

Thank you again for your feedback. I was able to buy an eBook containing the TWL ($0.99 + $0.40 tax) and have the solution I want without needing to change the algorithm. Currently, I am eating 12 seconds of the 3 minutes. This includes:

1. Switching from the browser window to the command window
2. Typing the 25 letters in the grid and hitting return
3. Switching back to the browser window
The majority of that time is spent correctly typing the 25 letters and the artificial 1 second sleep delay to ensure I can switch to the browser window before the code starts generating results.

[tilly]

I'm puzzled by your comment that DFS iteratively is ugly. The only difference between a DFS and BFS written iteratively is whether you push/shift to @work or push/pop. In fact now that I read more carefully you actually did a DFS, not a BFS, and I'm embarrassed to have not noticed it. (I got it wrong because I was skimming the first time, and I only write the iterative form for a BFS.)

I'd also recommend that you put some work pushing past your recursion block. Recursion is a very useful tool, and you're shortchanging yourself by not having it in your toolbox. It is a different mode of thinking, but it isn't particularly hard. However you'll need to force yourself to find opportunities to try it until it kind of "clicks". After it clicks, then you'll have a new tool in your toolbox. :-)

To write a recursive function I follow the following steps:

1. Write a function name that says it will solve the problem that I want solved.
2. Write the main recursive step where I somehow reduce the problem to a simpler problem.
3. Think through all of the possible "simplest problems" that I could run into and write code for those cases. At this stage I'll add dispatch logic if I need to.
4. Test my solution. Oversights are easy, and so it is worth testing when the code is fresh in my mind and fixes are easiest to make.

About the rest, I well understand reusing snippets you have lying around. For quick one-off programs that is a good approach. But if the one-off starts to become regularly used or to grow, then be aggressive on making it maintainable. The benefits of being maintainable tend to be so lopsided that it becomes a reflex for good programmers. But still there is an appropriate balance to maintain, and I think you're maintaining it.

[Anonymous Monk]

can i get 'my_dict.db' ?

[Limbic~Region]

Anonymous Monk,
In my code, you can see I generate the my_dict.db from a plain text word file (in my case, 'all_words.txt'). Any dictionary file will do. I believe I used one of the word lists from here initially.

I actually got the official word file from the developer Gareth Taft but I do not have his permission to post it publicly. Actually, I realize now that I never updated this node with my revised code after he explained the missing components of my reverse engineering of the rules. See below:

Score: 292,581,765
Biggest Chain: 3581
Highest Multiplier: 267
Best Word: JEEZ (172,125)

Read more... (10 kB)