A Lexical Roadtrip

Weekly Challenge Sun 30 June 2019

This is my solution to the challenge I set earlier this week: what's the longest word you can spell by traversing US states, taking the initial or initials of the states as you pass through them, without revisiting any states?

The data about US states are in JSON file that I provided:

{
 "AL": { "name":"Alabama", "initials":"a",  "adjacent":["FL","GA","TN","MS"] },
 ...
 "WY": { "name":"Wyoming", "initials":"w",  "adjacent":["CO","NE","SD","MT","ID","UT"] }
}

First off, load this into a perl data structure:

use File::JSON::Slurper qw/ read_json /;

my $states   = read_json('us-state-data.json');

I've a file of words, with one per line. We'll load this in, then sort it from longest to shortest:

use File::Slurper qw/ read_lines /;

my @words = sort { length($b) <=> length($a) }
            read_lines('word-list.txt');

We'll iterate over the words, until we find one that can be constructed by traversing states:

find_word_path($_) for @words;

This is going to be a recursive function: we'll see what state initials match the start of the word, and whenever there's a match, recursively call the function with the remainder of the word:

sub find_word_path {
    my ($word, @path) = @_;

    # get a list of state codes
    my @candidates    = ...

    foreach my $code (@candidates) {
        # skip the state if we've already visited it
        next if grep { $_ eq $code } @path;

        # convert "CA" to "c" for California, etc
        my $initials = $states->{$code}{initials};

        next unless $word =~ /^$initials(.*)$/;

        if ($1 eq '') {
            # We reached the end of the word!
        }
        else {
            find_word_path($1, @path, $code);
        }
    }
}

The function is called with the word to check, and then a list of zero or more state codes, for the path so far. If this is the start of a word, the path will be empty, and we can consider all states. Otherwise we can only consider those states adjacent to the state most recently visited; i.e. the last one in the path so far:

if (@path == 0) {
    @candidates = keys %$states;
}
else {
    @candidates = @{ $states->{ $path[-1] }{adjacent} };
}

As the function recurses, it's building up a list of state codes, but at the end we want to know the word. I could convert the list of state codes, mapping them to initials, but it's easier to just pass the full word every time.

Here's the final version:

sub find_word_path {
    my ($word, $fullword, @path) = @_;

    my @candidates = @path == 0
                   ? keys %$states
                   : @{ $states->{ $path[-1] }{adjacent} };

    foreach my $code (@candidates) {
        next if grep { $_ eq $code } @path;

        my $initials = $states->{$code}{initials};
        next unless $word =~ /^$initials(.*)$/;

        die "$fullword [@path $code]\n" if ($1 eq '');

        find_word_path($1, $fullword, @path, $code);
    }
}

The longest word it finds in my wordlist is CANUCK. Also of that length: COMATA, CONMAN, and MALMAG.

I could cut down the search space by filtering out words that contain letters that aren't initials of any states.

comments powered by Disqus