Re: [SPOILER] Solution to Perl 'Expert' Quiz-of-the-Week #22

I build two n-ary trees (using Tree::Simple) and look in both
directions until I either find an intersection, or one of leads to
nothing but dead ends. Everything is case insensitive -- that's how I
found the octavo->herpes path in Web2 when the other poster didn't.

#!/usr/bin/perl
use strict;
use warnings;
use Tree::Simple;

my ($start_word, $destination_word, $dictionary_file) = @ARGV;
die "You must specify two words of equal length" unless defined
$start_word and defined $destination_word and length $start_word ==
length $destination_word;

$dictionary_file ||= "/usr/share/dict/web2";
open (FH, $dictionary_file) or die "Couldn't open $dictionary_file: $!";

$start_word = lc $start_word;
$destination_word = lc $destination_word;

my %dict;
while (<FH>) {
    chomp;
    $dict{lc $_} = 1 if length $_ == length $start_word and $_ !~ /[^a-zA-Z]/;
}
close(FH);
die "$start_word is not in dictionary" unless exists $dict{$start_word};
die "$destination_word is not in dictionary" unless exists
$dict{$destination_word};

print "$start_word\n" and exit if $start_word eq $destination_word;

my ($list, $next_nodes);
{
    my $top = Tree::Simple->new($start_word);
    my $bottom = Tree::Simple->new($destination_word);

    $list = [{$start_word => $top}, {$destination_word => $bottom}];
    $next_nodes = [[$top],[$bottom]];
}

for (my $x = 0; ; $x = !$x) {
    $next_nodes->[$x] = find_next_nodes($next_nodes->[$x], $x);
}

sub find_next_nodes {
    my ($nodes, $x) = @_;
    my @next_nodes;
    for my $node (@$nodes) {
        my $orig_word = $node->getNodeValue();
        for (my $i = 0; $i < length $orig_word; $i++) {
            my $word = $orig_word;
            for my $char ('a'..'z') {
                next if $char eq substr $orig_word, $i, 1;
                substr $word, $i, 1, $char;

# if word is in other list, we're done

                success($x ? ($list->[!$x]->{$word}, $node) : ($node,
$list->[!$x]->{$word})) if exists $list->[!$x]->{$word};
                if (exists $dict{$word} and !exists $list->[$x]->{$word}) {
                    my $child = Tree::Simple->new($word);
                    $node->addChild($child); 
                    push @next_nodes, $child;
                    $list->[$x]->{$word} = $child;
                }
            }
        }
        prune($node) if $node->isLeaf;
    }
    return \@next_nodes;
}

sub success {
    my ($node1, $node2) = @_;
    print join "\n", (reverse word_chain($node1)), word_chain($node2), '';
    exit;
}

sub word_chain {
    my $node = shift;
    my @words;
    while (1) {
        push @words, $node->getNodeValue();
        last if $node->isRoot;
        $node = $node->getParent;
    }
    return @words;
}


sub prune {
    my $node = shift;
    while ($node->isLeaf) {
        die "No path exists" if $node->isRoot;
        my $parent = $node->getParent;
        $parent->removeChild($node);
        $node = $parent;
    }
}