Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:
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:
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.
Cheers - L~R
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Improve My FaceBook Scramble Solver
by tilly (Archbishop) on Aug 18, 2009 at 05:33 UTC | |
by Limbic~Region (Chancellor) on Aug 18, 2009 at 13:02 UTC | |
by tilly (Archbishop) on Aug 18, 2009 at 19:27 UTC | |
by Limbic~Region (Chancellor) on Aug 18, 2009 at 20:03 UTC | |
by Anonymous Monk on Feb 01, 2011 at 14:57 UTC | |
|
Re: Improve My FaceBook Scramble Solver
by Anonymous Monk on Dec 08, 2011 at 03:01 UTC | |
by Limbic~Region (Chancellor) on Dec 09, 2011 at 00:23 UTC |