#!/usr/bin/perl

use warnings;
use strict;

# Wordladder $from $to using dictionary file $dict.
my ($from, $to, $dict) = @ARGV;
  $dict = "wordlist" unless defined $dict;

unless(defined $from and defined $to and length $from == length $to) {
  print STDERR <<USAGE;
Usage: $0 from to [dictionary]

Generates a wordladder from 'from' to 'to' using dictionary 'dictionary'
(defaults to 'words' in current directory).

'from' and 'to' need to have the same length.
USAGE
  exit;
}

# We work lowercase.
local $_;
$_ = lc $_ for $from, $to;

# $words{x} is true if 'x' exists in the dictionary.
my %words;
open my $in, "<", $dict or die "Couldn't open $dict for reading: $!\n";
  while(<$in>) {
    chomp;
    next unless length == length $from;
    $words{lc $_}++;
  }
close $in or die "Couldn't close $dict: $!\n";

$words{$from}++;
$words{$to}++;

foreach my $word (keys %words) {
  foreach my $subst (subst($word)) {
    $words{$subst} = [] unless ref $words{$subst};
    push @{ $words{$subst} }, $word;
  }
}

my @ladder = ladder($from, $to);
if(@ladder) {
  print "$_\n" for @ladder;
  exit;
} else {
  print STDERR "No wordladder found.\n";
  exit 1;
}

sub subst {
  my ($word, @s) = (shift);

  for(my $i = 0; $i < length $word; $i++) {
    my $old = substr $word, $i, 1, " ";
    push @s, $word;
    substr($word, $i, 1) = $old;
  }

  return @s;
}

sub neighbours { local $_; grep { $_[0] ne $_ } map {@{ $words{$_} }} subst($_[0]) }

# Returns the wordladder from $src to $dest.
sub ladder {
  my ($src, $dest) = @_;

  my @candidates = ($src);
  my %wordinfo   = ($src => [] );

  while (@candidates) {
    my $word = shift @candidates;
    if ($word ne $dest) {
      my @chain  = @{ $wordinfo{$word} };
      my $length = 1 + @chain;
  
      foreach my $succ (neighbours($word)) {
	if($wordinfo{$succ} and $length >= @{ $wordinfo{$succ} }) {
	  # bad
	} else {
	  $wordinfo{$succ} = [ @chain, $word ];
	  push @candidates, $succ;
	}
      }
    }
  }

  return $wordinfo{$dest} ? (@{ $wordinfo{$dest} }, $dest) : ();
}
