As far as I know, and as far as I remember, nothing in this page does anything with Cookies.

## 2010/11/10

### Solving a Brain Teaser with word lists and Perl

I'm a programmer. When I see a problem, I get tempted to code the solution. One place where this temptation comes into play is brain teaser problems. Once, a while ago, a radio show had a brain teaster where you take the phrase PRECHRISTMAS SALE, turn it into a 4x4 block and find the longest word you can without reusing a letter. I used Perl and found six eight-letter words.

And, of course I used my powers on Sudoku.

Now, I've seen a problem that's inspired me again.
By changing one letter at a time to form different English words, and leaving all other letters in their original positions, convert SIXTH into TENTH in the fewest steps possible. Good luck!

```S I X T H
_ _ _ _ _
_ _ _ _ _
_ _ _ _ _
_ _ _ _ _
_ _ _ _ _
_ _ _ _ _
T E N T H```
There are Spoilers below

As I learned with `PRECHRISTMASSALE`, which I've since found is Boggle, if you're going to find words, you first need to know words. So, I pulled and adapted my Boggle code for coming up with a dictionary list.
```sub dictionary {
my ( \$length ) = @_ ;
my %done ;
my %word ;
my \$dir = './Dict' ;
my \$dirhandle ;
opendir \$dirhandle, \$dir ;
my \$file ;
while ( defined( \$file = readdir \$dirhandle ) ) {
next if \$file =~ m(^\.)mx ;
open my \$filehandle, '<', \$dir . q{/} . \$file ;
while ( <\$filehandle> ) {
chomp ;
\$_ = lc \$_ ;
next if \$done{ \$_ }++ ;
next if length != \$length ;
\$word{ \$_ }++ ;
}
close \$filehandle ;
}
closedir \$dirhandle ;
return sort { \$a cmp \$b } keys %word ;
}
```
Of course, you need to be in the same directory as a directory full of dictionaries. I used a few I pulled from the CERIAS FTP site, and probably has some overlap, but better that then missing a word and thus a connection.

I then started poking at the words, trying to find the next. I came up with a way to get all the proper alternatives, given a word. I then pulled it into a subroutine.
```sub get_word_choices {
my ( \$word ) = shift ;
my @word = split m{}mx, \$word ;
my @output ;
for my \$pos ( 0 .. scalar @word - 1 ) {
my @local = @word ;
\$local[ \$pos ] = '.' ;
my \$local = join '', @local ;
my @words = grep { m{\$local}mx } grep { !m{\$word}mx } @dictionary ;
next if scalar @words == 0 ;
push @output , @words ;
}
return @output ;
}
```
I should probably pass `@dictionary` rather than leave it as a global, but certainly, you don't want to re-parse the dictionary file each time.

It struck me about this point that I should have all I need to automatically solve this, not leaving me to use this tool to piece something together.

I am not as happy with this part as I could be.
```sub check_words {
my \$word2 = shift ;
my @words = @_ ;
return if scalar @words > 7 ;
my \$last = \$words[-1] ;
if ( \$last eq \$word2 ) {
say '' ;
say join ' ' , @words , scalar @words ;
}
my @choices = get_word_choices( \$last ) ;
#say join ' ' , @words ;
for my \$choice ( @choices ) {
next if grep { m{\$choice}mx } @words ;
check_words( \$word2 , @words , \$choice ) ;
}
print join ' ' ,  '' , scalar @words ;
return ;
}
```
It's depth-first search and it's long. Which, I suppose, is unavoidable for depth-first search. Consider this solution:
```sixth
sixte
sixty
silty
tilty
tinty
tenty
tenth ```
sixth to sixty is just as legal a jump as sixth to sixte. If I used an iterative process with a better data structure, I could use a shortest path algorithm and bypass sixte. And, of course, by putting `print` to give me some appreciation of progress, I'm bogging the thing way down. So, that's where I'd rewrite to make this better.