#!/usr/bin/perl

use strict;
use warnings;

use constant DEFAULT_DICTIONARY => "$ENV{HOME}/words/Web2";

use Inline (C => 'DATA', CCFLAGS => '-std=c99');

# Process parameters.
my ($start, $target) = @ARGV;
defined $start and defined $target and @ARGV <= 3 or die <<USAGE;
Usage: $0 starting_word target_word [dict_file]
USAGE

length($start) == length($target) or die <<ERROR;
Error: starting_word and target_word must have the same length
ERROR

# Normalize words to lowercase, we'll do the same with the ones
# in the dictionary.
$start  = lc $start;
$target = lc $target;

# Process dictionary.
my $len = length($start);
my $dict_file = @ARGV == 3 ? $ARGV[2] : DEFAULT_DICTIONARY;
open my $dict, $dict_file or die $!;

# Stores those words in the dictionary that have the same length
# of the ones we received. We use a hash instead of an array
# because we'll need to delete sets of words easily.
my %words = ();
while (defined(my $word = <$dict>)) {
     next unless /\S/; # skip blank lines
     chomp $word;
     next unless $len == length $word;
     $words{lc $word} = 1;
}
close $dict;

# Ensure the dictionary contains those words.
$words{$start} or die <<ERROR;
Error: $start was not found in $dict_file
ERROR
$words{$target} or die <<ERROR;
Error: $target was not found in $dict_file
ERROR

# Start the actual search.
my @ladder = ();

# Cache distances to the target.
my %distance_to_target = ();
$distance_to_target{$_} = distance($_, $target) for keys %words;

# This is a recursive function rewritten as a loop with a stack.
# Several examples produced too nesting so it wasn't an option.
delete $words{$start};
my @stack = ([$start]);
LOOP: while () {
     my $step = $stack[-1][-1];
     push @ladder, $step;
     if ($distance_to_target{$step} == 1) {
         push @ladder, $target;
         last LOOP; # ladder completed, all done
     }

     # We order the words one step away of $step so that those
     # closer to the target are visited first.
     #
     # This is _descending_ order because we go over the stack
     # from right to left.
     my @candidates =
       sort { $distance_to_target{$b} <=> $distance_to_target{$a} }
       grep { are_one_step_away($step, $_) }
       keys %words;

     if (@candidates) {
         delete @words{@candidates};
         push @stack, \@candidates;
     } else {
         BACKTRACK: while () {
             pop @ladder;
             pop @{$stack[-1]};
             if (not @{$stack[-1]}) {
                 pop @stack;
                 if (not @stack) {
                     last LOOP; # empty stack, no ladder was found
                 }
             } else {
                 last BACKTRACK; # backtracking done, try another branch
             }
         }
     }
}

#print @ladder ? "@ladder\n" : "no ladder was found\n";
print "$_\n" for @ladder;
exit(1) unless @ladder;

__DATA__
__C__
#include <string.h>

/* Returns the number of substitutions needed to go from word1 to word2.
    Assumes word1 and word2 have the same length. */
int distance(char* word1, char* word2)
{
     int subs = 0;
     int i = 0;
     for (i = 0; i < strlen(word1); ++i)
         if (word1[i] != word2[i])
             ++subs;
     return subs;
}

/* A better test for distance(word1, word2) == 1.
    Assumes word1 and word2 have the same length. */
int are_one_step_away(char* word1, char* word2)
{
     int diffs = 0;
     int i = 0;
     for (i = 0; i < strlen(word1); ++i)
         if (word1[i] != word2[i])
             if (++diffs == 2)
               return 0;
     return diffs;
}
