#!/usr/bin/perl -w -l

use strict;
use String::Approx 'amatch';

my $VERBOSE=1;
die "Usage: $0 startword endword <dictionaryfile>\n" if @ARGV<2 or @ARGV>3;
my ($from, $to, $dict) = @ARGV;
$dict ||= "Web2.txt";

my $l = length($from);
die "Unequal word lengths\n" unless length($to) == $l;
die "Identical start- and endwords\n" if $from eq $to;

open DICT, $dict or die "Couldn't open dictionary file for reading: $!\n";

my %words;
for (<DICT>,$from,$to)
{
        chomp;
        $words{lc $_} = 1 if length==$l;
}

my %parent; # traces shortest path
my @stack;
my $iter = 0;
push @stack, $from;
push @stack, "ITERATION " if $VERBOSE;
$parent{$from} = 'MARKER'; # must reread algorithm - look for more elegant solution
$parent{MARKER} = $to;
delete $words{$from};

BFS: while (my $node = shift @stack)
{
        if ($VERBOSE and $node eq "ITERATION ")
        {
                last unless @stack;
                #warn "$node ".++$iter." | #stack ".(scalar @stack)." | @stack\n";
                push @stack, "ITERATION ";
                next;
        }
        for my $child (amatch($node,["S1","I0","D0"],keys %words))
        {
                next if exists $parent{$child};
                delete $words{$child};
                $parent{$child} = $node;
                last BFS if $child eq $to;
                push @stack, $child;
        }
}

die "No path found\n" unless exists $parent{$to};

my @trace;
my $node = 'MARKER';
while ($node = $parent{$node})
{
        last if $node eq 'MARKER';
        push @trace, $node;
}
print join "\n", reverse @trace;
