Yet another shortest path problem. Given two words of equal length the task is to transpose the first into the second.

Only one letter may be changed at a time and the change must result in a word in unixdict, the minimum number of intermediate words should be used.

Demonstrate the following:

A boy can be made into a man: boy -> bay -> ban -> man

With a little more difficulty a girl can be made into a lady: girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady

A john can be made into a jane: john -> cohn -> conn -> cone -> cane -> jane

A child can not be turned into an adult.

Optional transpositions of your choice.




Other tasks related to string operations:

Metrics
 Array length
 String length
 Copy a string
 Empty string  (assignment)
Counting
 Word frequency
 Letter frequency
 Jewels and stones
 I before E except after C
 Bioinformatics/base count
 Count occurrences of a substring
 Count how many vowels and consonants occur in a string
Remove/replace
 XXXX redacted
 Conjugate a Latin verb
 Remove vowels from a string
 String interpolation (included)
 Strip block comments
 Strip comments from a string
 Strip a set of characters from a string
 Strip whitespace from a string -- top and tail
 Strip control codes and extended characters from a string
Anagrams/Derangements/shuffling
 Word wheel
 ABC problem
 Sattolo cycle
 Knuth shuffle
 Ordered words
 Superpermutation minimisation
 Textonyms (using a phone text pad)
 Anagrams
 Anagrams/Deranged anagrams
 Permutations/Derangements
Find/Search/Determine
 ABC words
 Odd words
 Word ladder
 Semordnilap
 Word search
 Wordiff  (game)
 String matching
 Tea cup rim text
 Alternade words
 Changeable words
 State name puzzle
 String comparison
 Unique characters
 Unique characters in each string
 Extract file extension
 Levenshtein distance
 Palindrome detection
 Common list elements
 Longest common suffix
 Longest common prefix
 Compare a list of strings 
 Longest common substring
 Find common directory path
 Words from neighbour ones
 Change e letters to i in words
 Non-continuous subsequences
 Longest common subsequence
 Longest palindromic substrings
 Longest increasing subsequence
 Words containing "the" substring
 Sum of the digits of n is substring of n
 Determine if a string is numeric
 Determine if a string is collapsible
 Determine if a string is squeezable
 Determine if a string has all unique characters
 Determine if a string has all the same characters
 Longest substrings without repeating characters
 Find words which contains all the vowels
 Find words which contains most consonants
 Find words which contains more than 3 vowels
 Find words which first and last three letters are equals
 Find words which odd letters are consonants and even letters are vowels or vice_versa
Formatting
 Substring
 Rep-string
 Word wrap
 String case
 Align columns
 Literals/String
 Repeat a string
 Brace expansion
 Brace expansion using ranges
 Reverse a string
 Phrase reversals
 Comma quibbling
 Special characters
 String concatenation
 Substring/Top and tail
 Commatizing numbers
 Reverse words in a string
 Suffixation of decimal numbers
 Long literals, with continuations 
 Numerical and alphabetical suffixes
 Abbreviations, easy
 Abbreviations, simple
 Abbreviations, automatic
Song lyrics/poems/Mad Libs/phrases
 Mad Libs
 Magic 8-ball
 99 Bottles of Beer
 The Name Game (a song)
 The Old lady swallowed a fly
 The Twelve Days of Christmas
Tokenize
 Text between
 Tokenize a string
 Word break problem
 Tokenize a string with escaping
 Split a character string based on change of character
Sequences
 Show ASCII table
 De Bruijn sequences
 Self-referential sequences
 Generate lower case ASCII alphabet




# quick implementation of a stack of INT.
  real program starts after it.
#
MODE STACK = STRUCT (INT top, FLEX[1:0]INT data, INT increment);
 
PROC makestack = (INT increment)STACK: (1, (), increment);
 
PROC pop = (REF STACK s)INT: ( top OF s -:= 1; (data OF s)[top OF s] );
 
PROC push = (REF STACK s, INT n)VOID:
  BEGIN
    IF top OF s > UPB data OF s THEN
      [ UPB data OF s + increment OF s ]INT tmp;
      tmp[1 : UPB data OF s] := data OF s;
      data OF s := tmp
    FI;
    (data OF s)[top OF s] := n;
    top OF s +:= 1
  END;
 
PROC empty = (REF STACK s)BOOL: top OF s <= 1;
 
PROC contents = (REF STACK s)[]INT: (data OF s)[:top OF s - 1];
 
# start solution #
 
[]STRING words = BEGIN     # load dictionary file into array #
                   FILE f;
                   BOOL eof := FALSE;
                   open(f, "unixdict.txt", stand in channel);
                   on logical file end(f, (REF FILE f)BOOL: eof := TRUE);
                   INT idx := 1;
                   FLEX [1:0] STRING words;
                   STRING word;
                   WHILE NOT eof DO
                     get(f, (word, newline));
                     IF idx > UPB words THEN
                       HEAP [1 : UPB words + 10000]STRING tmp;
                       tmp[1 : UPB words] := words;
                       words := tmp
                     FI;
                     words[idx] := word;
                     idx +:= 1
                   OD;
                   words[1:idx-1]
                 END;
 
INT nwords = UPB words;
 
INT max word length = (INT mwl := 0;
                       FOR i TO UPB words DO
                         IF mwl < UPB words[i] THEN mwl := UPB words[i] FI
                       OD;
                       mwl);
 
[nwords]FLEX[0]INT neighbors;
 
[max word length]BOOL precalculated by length;
 
FOR i TO UPB precalculated by length DO precalculated by length[i] := FALSE OD;
 
# precalculating neighbours takes time, but not doing it is even slower... #
PROC precalculate neighbors = (INT word length)VOID:
  BEGIN
    [nwords]REF STACK stacks;
    FOR i TO UPB stacks DO stacks[i] := NIL OD;
    FOR i TO UPB words DO
      IF UPB words[i] = word length THEN
        IF REF STACK(stacks[i]) :=: NIL THEN stacks[i] := HEAP STACK := makestack(10) FI;
        FOR j FROM i + 1 TO UPB words DO
          IF UPB words[j] = word length THEN
            IF neighboring(words[i], words[j]) THEN
              push(stacks[i], j);
              IF REF STACK(stacks[j]) :=: NIL THEN stacks[j] := HEAP STACK := makestack(10) FI;
              push(stacks[j], i)
            FI
          FI
        OD
      FI
    OD;
    FOR i TO UPB neighbors DO
      IF REF STACK(stacks[i]) :/=: NIL THEN
        neighbors[i] := contents(stacks[i])
      FI
    OD;
    precalculated by length [word length] := TRUE
  END;
 
PROC neighboring = (STRING a, b)BOOL:      # do a & b differ in just 1 char? #
  BEGIN
    INT diff := 0;
    FOR i TO UPB a DO IF a[i] /= b[i] THEN diff +:= 1 FI OD;
    diff = 1
  END;
 
PROC word ladder = (STRING from, STRING to)[]STRING:
  BEGIN
    IF UPB from /= UPB to THEN fail FI;
    INT word length = UPB from;
    IF word length < 1 OR word length > max word length THEN fail FI;
    IF from = to THEN fail FI;
    INT start := 0;
    INT destination := 0;
    FOR i TO UPB words DO
      IF UPB words[i] = word length THEN
        IF words[i] = from THEN start := i
        ELIF words[i] = to THEN destination := i
        FI
      FI
    OD;
    IF destination = 0 OR start = 0 THEN fail FI;
    IF NOT precalculated by length [word length] THEN
      precalculate neighbors(word length)
    FI;
    STACK stack := makestack(1000);
    [nwords]INT distance;
    [nwords]INT previous;
    FOR i TO nwords DO distance[i] := nwords+1; previous[i] := 0 OD;
    INT shortest := nwords+1;
    distance[start] := 0;
    push(stack, start);
    WHILE NOT empty(stack)
    DO
      INT curr := pop(stack);
      INT dist := distance[curr];
      IF dist < shortest - 1 THEN
        # find neighbors and add them to the stack #
        FOR i FROM UPB neighbors[curr] BY -1 TO 1 DO
          INT n = neighbors[curr][i];
          IF distance[n] > dist + 1 THEN
            distance[n] := dist + 1;
            previous[n] := curr;
            IF n = destination THEN
              shortest := dist + 1
            ELSE
              push(stack, n)
            FI
          FI
        OD;
        IF curr = destination THEN shortest := dist FI
      FI
    OD;
    INT length = distance[destination] + 1;
    IF length > nwords THEN fail FI;
    [length]STRING result;
    INT curr := destination;
    FOR i FROM length BY -1 TO 1
    DO
      result[i] := words[curr];
      curr := previous[curr]
    OD;
    result EXIT
    fail: LOC [0] STRING
  END;
 
[][]STRING pairs = (("boy", "man"), ("bed", "cot"),
                    ("old", "new"), ("dry", "wet"),
 
                    ("girl", "lady"), ("john", "jane"),
                    ("lead", "gold"), ("poor", "rich"),
                    ("lamb", "stew"), ("kick", "goal"),
                    ("cold", "warm"), ("nude", "clad"),
 
                    ("child", "adult"), ("white", "black"),
                    ("bread", "toast"), ("lager", "stout"),
                    ("bride", "groom"), ("table", "chair"),
 
                    ("bubble", "tickle"));
 
FOR i TO UPB pairs
DO
  STRING from = pairs[i][1], to = pairs[i][2];
  []STRING ladder = word ladder(from, to);
  IF UPB ladder = 0
  THEN print(("No solution for """ + from + """ -> """ + to + """", newline))
  ELSE FOR j TO UPB ladder DO print(((j > 1 | "->" | ""), ladder[j])) OD;
       print(newline)
  FI
OD