program ladder(input, output);

label 999;

const
  NONE = -1;
  wordLength = 4;
  maxSteps = 99;
  maxWords = 20000;
  infinite = 99999;

type
  dictIndex = -1..maxWords;
  fixedLength = packed array [1..wordLength] of char;
  wordStatus = record
                 dist: integer;
                 prev: dictIndex;
                 word: fixedLength;
               end;
  dictionary = array [dictIndex] of wordStatus;

var
  lastWord: dictIndex;
  dict: dictionary;
  first, last: fixedLength;
  firstIdx, lastIdx: dictIndex;
  dictfile: text;

procedure InitVars;
begin
  lastWord := -1;
{  reset(input, 'TT:'); }
{  rewrite(output, 'TT:'); }
  reset(dictFile, 'word4');
end;

procedure ResetVars;
var each:dictIndex;
begin
  for each := 0 to lastWord do begin
    with dict[each] do begin
      prev := NONE;
      dist := infinite;
    end;
  end;
end;

procedure ReadDict(var dict: dictionary);
var i: 1..wordLength;
begin
  while (not eof(dictfile)) and (lastWord < maxWords) do begin
    lastWord := lastWord + 1;
    with dict[lastWord] do begin
      for i := 1 to wordLength do Read(dictfile, word[i]); ReadLn(dictfile);
{     WriteLn('Added word ', word);}
      prev := NONE;
      dist := infinite;
    end;
  end;
{ WriteLn('End of file - Dictionary Read OK');}
end;

function Idx(word: fixedLength): dictIndex;
label 999;
var mid, l, r: dictIndex;
begin
  r := lastWord; l := 0; mid := l; Idx := -1;
  while l<=r do begin
    mid := (l+r) div 2;
    if word >= dict[mid].word then begin
      if word=dict[mid].word then begin
        Idx := mid;
        goto 999;
      end;
      l := mid+1;
    end else begin
      r := mid-1;
    end;
  end;
999:
end;

procedure SortDict(low, high: dictIndex);
{ This is a totally brain-damaged quicksort out of a book for
  American University students. God help them... }
var
  pivot: fixedLength;
  last,
  pivotIndex: dictIndex;
  function FindPivot(low, high: dictIndex): dictIndex;
  begin
    if (low < high) then FindPivot := low else FindPivot := -1
  end;
  procedure Partition(var last:dictIndex;
                          low, high: dictIndex;
                          pivot: fixedLength);
  var dex: dictIndex;
    procedure Swap(one, two: dictIndex);
    var temp: wordStatus;
    begin
      temp := dict[one];
      dict[one] := dict[two];
      dict[two] := temp;
    end;
  begin
    last := low;
    for dex := low+1 to high do
      if dict[dex].word < pivot then begin
        last := last+1;
        Swap(Last, dex);
      end;
    if (low <> last) then Swap(low, last);
  end;
begin
  pivotIndex := FindPivot(low, high);
  if pivotIndex <> -1 then begin
    pivot := dict[pivotIndex].word;
    Partition(last, low, high, pivot);
    SortDict(low, last-1);
    SortDict(last+1, high);
  end;
end;

procedure ReadWord(var word: fixedLength);
var i: 1..wordLength;
begin
{ WriteLn('Reading a word...');}
  for i := 1 to wordLength do begin
    Read(word[i]);
{    WriteLn('Word[', i, '] = ', ORD(word[i]));}
  end;
  ReadLn;
{  WriteLn('Word is <', word, '>');}
end;

procedure FindLadders(last, root: dictIndex);
label 999;
var
  word: fixedLength;
  chpos: 1..wordLength;
  level: 0..999;
  test, neighbour: dictIndex;
  ch, other: char;
begin
  dict[root].dist := 0;
  for level := 1 to maxSteps do begin
    for test := 0 to lastWord do begin;
      if dict[test].dist = pred(level) then begin
        word := dict[test].word;
        for chpos := 1 to wordLength do begin
          ch := word[chpos];
          for other := 'a' to 'z' do begin
            if ch <> other  then begin
              word[chpos] := other;
              neighbour := Idx(word);
              if (neighbour <> -1) and (dict[neighbour].dist > level)
              then begin
                dict[neighbour].dist := level;
                dict[neighbour].prev := test;
{               WriteLn(dict[test].word, ' -> ', word);}
              end;
            end;
          end;
          word[chpos] := ch;
        end;
      end
    end;
    if dict[last].dist <> infinite then begin
      WriteLn(level, ' step path found!');
      goto 999;
    end;
    writeln('Finished level ', level);
  end;
999:
end;

procedure PrintLadders(root, last: dictIndex);
var prev: dictIndex;
begin
  if dict[root].dist = infinite then begin
    writeln('No path found between ', dict[root].word,
                             ' and ', dict[last].word);
  end else begin
    writeln(dict[root].word);
    repeat
      prev := dict[root].prev;
      writeln(dict[prev].word);
      root := prev;
    until root = last;
  end;
end;

begin
  InitVars;
  ReadDict(dict);
{  SortDict(0, lastWord);}
  repeat
    repeat
      Write('From: ');
      ReadWord(first);
      firstIdx := Idx(first);
      if firstIdx=-1 then WriteLn(first, ' is not in the dictionary');
    until firstIdx <> -1;
    repeat
      Write('To:   ');
      ReadWord(last);
      lastIdx := Idx(last);
      if lastIdx=-1 then WriteLn(last, ' is not in the dictionary');
    until lastIdx <> -1;
    FindLadders(firstIdx, lastIdx);
    PrintLadders(firstIdx, lastIdx);
    ResetVars;
  until false;
999:
end.