Word ladder

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

Counting

Remove/replace

Anagrams/Derangements/shuffling

Find/Search/Determine

Formatting

Song lyrics/poems/Mad Libs/phrases

Tokenize

Sequences

11l

Translation of: Nim

<lang 11l>F isOneAway(word1, word2)

  V result = 0B
  L(i) 0 .< word1.len
     I word1[i] != word2[i]
        I result
           R 0B
        E
           result = 1B
  R result

DefaultDict[Int, [String]] words

L(word) File(‘unixdict.txt’).read().split("\n")

  words[word.len] [+]= word

F find_path(start, target)

  V lg = start.len
  assert(target.len == lg, ‘Source and destination must have same length.’)
  assert(start C :words[lg], ‘Source must exist in the dictionary.’)
  assert(target C :words[lg], ‘Destination must exist in the dictionary.’)

  V currPaths = start
  V pool = copy(:words[lg])

  L
     String newPaths
     [String] added
     L(candidate) pool
        L(path) currPaths
           I isOneAway(candidate, path.last)
              V newPath = path [+] [candidate]
              I candidate == target
                 R newPath
              E
                 newPaths.append(newPath)
                 added.append(candidate)
                 L.break

     I newPaths.empty
        L.break
     currPaths = move(newPaths)
     L(w) added
        pool.remove(w)

  R [String]()

L(start, target) [(‘boy’, ‘man’), (‘girl’, ‘lady’), (‘john’, ‘jane’), (‘child’, ‘adult’), (‘cat’, ‘dog’), (‘lead’, ‘gold’), (‘white’, ‘black’), (‘bubble’, ‘tickle’)]

  V path = find_path(start, target)
  I path.empty
     print(‘No path from "’start‘" to "’target‘".’)
  E
     print(path.join(‘ -> ’))</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
No path from "child" to "adult".
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle

// If possible, print the shortest chain of single-character modifications that // leads from "from" to "to", with each intermediate step being a valid word. // This is an application of breadth-first search. bool word_ladder(const word_map& words, const std::string& from,

                const std::string& to) {
   auto w = words.find(from.size());
   if (w != words.end()) {
       auto poss = w->second;
       std::vector<std::vector<std::string>> queueTemplate:From;
       while (!queue.empty()) {
           auto curr = queue.front();
           queue.erase(queue.begin());
           for (auto i = poss.begin(); i != poss.end();) {
               if (!one_away(*i, curr.back())) {
                   ++i;
                   continue;
               }
               if (to == *i) {
                   curr.push_back(to);
                   std::cout << join(curr.begin(), curr.end(), " -> ") << '\n';
                   return true;
               }
               std::vector<std::string> temp(curr);
               temp.push_back(*i);
               queue.push_back(std::move(temp));
               i = poss.erase(i);
           }
       }
   }
   std::cout << from << " into " << to << " cannot be done.\n";
   return false;

}

int main() {

   word_map words;
   std::ifstream in("unixdict.txt");
   if (!in) {
       std::cerr << "Cannot open file unixdict.txt.\n";
       return EXIT_FAILURE;
   }
   std::string word;
   while (getline(in, word))
       words[word.size()].push_back(word);
   word_ladder(words, "boy", "man");
   word_ladder(words, "girl", "lady");
   word_ladder(words, "john", "jane");
   word_ladder(words, "child", "adult");
   word_ladder(words, "cat", "dog");
   word_ladder(words, "lead", "gold");
   word_ladder(words, "white", "black");
   word_ladder(words, "bubble", "tickle");
   return EXIT_SUCCESS;

}</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle

F#

<lang fsharp> // Word ladder: Nigel Galloway. June 5th., 2021 let fG n g=n|>List.partition(fun n->2>Seq.fold2(fun z n g->z+if n=g then 0 else 1) 0 n g) let wL n g=let dict=seq{use n=System.IO.File.OpenText("unixdict.txt") in while not n.EndOfStream do yield n.ReadLine()}|>Seq.filter(Seq.length>>(=)(Seq.length n))|>List.ofSeq|>List.except [n]

          let (|Done|_|) n=n|>List.tryFind((=)g)
          let rec wL n g l=match n with h::t->let i,e=fG l (List.head h) in match i with Done i->Some((i::h)|>List.rev) |_->wL t ((i|>List.map(fun i->i::h))@g) e
                                       |_->match g with []->None |_->wL g [] l
          let i,e=fG dict n in match i with Done i->Some([n;g]) |_->wL(i|>List.map(fun g->[g;n])) [] e

[("boy","man");("girl","lady");("john","jane");("child","adult")]|>List.iter(fun(n,g)->printfn "%s" (match wL n g with Some n->n|>String.concat " -> " |_->n+" into "+g+" can't be done")) </lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult can't be done

Optional transpositions

The bad news is evil can not be turned into good, but the good news is god can become man.

<lang fsharp> [("evil","good");("god","man")]|>List.iter(fun(n,g)->printfn "%s" (match wL n g with Some n->n|>String.concat " -> " |_->n+" into "+g+" can't be done")) </lang>

Output:

evil into good can't be done done
god -> gad -> mad -> man

Go

Translation of: Wren

<lang go>package main

import (

   "bytes"
   "fmt"
   "io/ioutil"
   "log"
   "strings"

)

func contains(a []string, s string) bool {

   for _, e := range a {
       if e == s {
           return true
       }
   }
   return false

}

func oneAway(a, b string) bool {

   sum := 0
   for i := 0; i < len(a); i++ {
       if a[i] != b[i] {
           sum++
       }
   }
   return sum == 1

}

func wordLadder(words []string, a, b string) {

   l := len(a)
   var poss []string
   for _, word := range words {
       if len(word) == l {
           poss = append(poss, word)
       }
   }
   todo := [][]stringTemplate:A
   for len(todo) > 0 {
       curr := todo[0]
       todo = todo[1:]
       var next []string
       for _, word := range poss {
           if oneAway(word, curr[len(curr)-1]) {
               next = append(next, word)
           }
       }
       if contains(next, b) {
           curr = append(curr, b)
           fmt.Println(strings.Join(curr, " -> "))
           return
       }
       for i := len(poss) - 1; i >= 0; i-- {
           if contains(next, poss[i]) {
               copy(poss[i:], poss[i+1:])
               poss[len(poss)-1] = ""
               poss = poss[:len(poss)-1]
           }
       }
       for _, s := range next {
           temp := make([]string, len(curr))
           copy(temp, curr)
           temp = append(temp, s)
           todo = append(todo, temp)
       }
   }
   fmt.Println(a, "into", b, "cannot be done.")

}

func main() {

   b, err := ioutil.ReadFile("unixdict.txt")
   if err != nil {
       log.Fatal("Error reading file")
   }
   bwords := bytes.Fields(b)
   words := make([]string, len(bwords))
   for i, bword := range bwords {
       words[i] = string(bword)
   }
   pairs := [][]string{
       {"boy", "man"},
       {"girl", "lady"},
       {"john", "jane"},
       {"child", "adult"},
   }
   for _, pair := range pairs {
       wordLadder(words, pair[0], pair[1])
   }

}</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.

Haskell

Breadth-first search

The function first expands a ball around the starting word in the space of possible words, until the ball surface touches the goal (if ever). After that it performs depth-first path-finding from the goal back to the center.

<lang haskell>import System.IO (readFile) import Control.Monad (foldM) import Data.List (intercalate) import qualified Data.Set as S

distance :: String -> String -> Int distance s1 s2 = length $ filter not $ zipWith (==) s1 s2

wordLadders :: [String] -> String -> String -> String wordLadders dict start end

 | length start /= length end = []
 | otherwise = [wordSpace] >>= expandFrom start >>= shrinkFrom end
 where

   wordSpace = S.fromList $ filter ((length start ==) . length) dict

   expandFrom s = go s
     where
       go (h:t) d
         | S.null d || S.null f = []
         | end `S.member` f = [h:t]
         | otherwise = go (S.elems f:h:t) (d S.\\ f)
         where
           f = foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty h

   shrinkFrom = scanM (filter . oneStepAway)

   oneStepAway x = (1 ==) . distance x
   
   scanM f x = fmap snd . foldM g (x,[x])
     where g (b, r) a = (\x -> (x, x:r)) <$> f b a

wordLadder :: [String] -> String -> String -> [String] wordLadder d s e = case wordLadders d s e of

                    [] -> []
                    h:_ -> h

showChain [] = putStrLn "No chain" showChain ch = putStrLn $ intercalate " -> " ch

main = do

 dict <- lines <$> readFile "unixdict.txt"
 showChain $ wordLadder dict "boy" "man"
 showChain $ wordLadder dict "girl" "lady"
 showChain $ wordLadder dict "john" "jane"
 showChain $ wordLadder dict "alien" "drool"
 showChain $ wordLadder dict "child" "adult"</lang>

λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "boy" "man"
[["boy","bay","ban","man"],["boy","bon","ban","man"],["boy","bay","may","man"]]

λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "girl" "lady"
[["girl","gill","gall","gale","gaze","laze","lazy","lady"]]

λ> lines <$> readFile "unixdict.txt" >>= print . wordLadders "child" "adult"
[]

λ> main
boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
alien -> alden -> alder -> alter -> aster -> ester -> eater -> bater -> bator -> baton -> baron -> boron -> moron -> moran -> moral -> morel -> monel -> money -> monty -> month -> mouth -> south -> sooth -> sloth -> slosh -> slash -> flash -> flask -> flank -> blank -> bland -> blend -> bleed -> breed -> bread -> tread -> triad -> trial -> trill -> drill -> droll -> drool
No chain

Two-sided breadth-first search

Performs searching from both ends. This solution is much faster for cases with no chains, and for for short chains. In case of long chains looses its' efficiency.

<lang haskell>wordLadders2 :: String -> String -> [String] -> String wordLadders2 start end dict

 | length start /= length end = []
 | otherwise = pure wordSpace >>= expand start end >>= shrink end
 where

   wordSpace = S.fromList $ filter ((length start ==) . length) dict

   expand s e d = tail . map S.elems <$> go [S.singleton s] [S.singleton e] d
     where
       go (hs:ts) (he:te) d
         | S.null d || S.null fs || S.null fe = []
         | not $ S.null f1 = [reverse (f1:te) ++ hs:ts]
         | not $ S.null f2 = [reverse (he:te) ++ f2:ts]
         | not $ S.null f3 = [reverse (he:te) ++ f3:hs:ts]
         | otherwise = go (fs:hs:ts) (fe:he:te) (d S.\\ hs S.\\ he)
         where
           fs = front hs
           fe = front he
           f1 = fs `S.intersection` he
           f2 = fe `S.intersection` hs
           f3 = fs `S.intersection` fe
           front = S.foldr (\w -> S.union (S.filter (oneStepAway w) d)) mempty

   shrink = scanM (findM . oneStepAway)

   oneStepAway x = (1 ==) . distance x

   scanM f x = fmap snd . foldM g (x,[x])
     where g (b, r) a = (\x -> (x, x:r)) <$> f b a

   findM p = msum . map (\x -> if p x then pure x else mzero)</lang>

Using A*-search

See A*_search_algorithm#Haskell

<lang haskell>import AStar (findPath, Graph(..)) import qualified Data.Map as M

distance :: String -> String -> Int distance s1 s2 = length $ filter not $ zipWith (==) s1 s2

wordLadder :: [String] -> String -> String -> [String] wordLadder dict start end = findPath g distance start end

 where
   short_dict = filter ((length start ==) . length) dict
   g = Graph $ \w -> M.fromList [ (x, 1)
                                | x <- short_dict
                                , distance w x == 1 ]</lang>

λ> main
boy -> bay -> ban -> man
girl -> gird -> bird -> bard -> lard -> lark -> lack -> lacy -> lady
john -> cohn -> conn -> cone -> cane -> jane
alien -> alden -> alder -> alter -> aster -> ester -> eater -> bater -> bator -> baton -> baron -> boron -> moron -> moran -> moral -> morel -> monel -> money -> monty -> month -> mouth -> south -> sooth -> sloth -> slosh -> slash -> flash -> flask -> flank -> blank -> bland -> blend -> bleed -> breed -> bread -> tread -> triad -> trial -> trill -> drill -> droll -> drool
No chain

Works much faster when compiled.

Java

<lang java>import java.io.IOException; import java.nio.file.Files; import java.nio.file.Path; import java.util.ArrayList; import java.util.HashMap; import java.util.HashSet; import java.util.List; import java.util.Map; import java.util.PriorityQueue; import java.util.Set; import java.util.stream.IntStream;

public class WordLadder {

   private static int distance(String s1, String s2) {
       assert s1.length() == s2.length();
       return (int) IntStream.range(0, s1.length())
           .filter(i -> s1.charAt(i) != s2.charAt(i))
           .count();
   }

   private static void wordLadder(Map<Integer, Set<String>> words, String fw, String tw) {
       wordLadder(words, fw, tw, 8);
   }

   private static void wordLadder(Map<Integer, Set<String>> words, String fw, String tw, int limit) {
       if (fw.length() != tw.length()) {
           throw new IllegalArgumentException("From word and to word must have the same length");
       }

       Set<String> ws = words.get(fw.length());
       if (ws.contains(fw)) {
           List<String> primeList = new ArrayList<>();
           primeList.add(fw);

           PriorityQueue<List<String>> queue = new PriorityQueue<>((chain1, chain2) -> {
               int cmp1 = Integer.compare(chain1.size(), chain2.size());
               if (cmp1 == 0) {
                   String last1 = chain1.get(chain1.size() - 1);
                   int d1 = distance(last1, tw);

                   String last2 = chain2.get(chain2.size() - 1);
                   int d2 = distance(last2, tw);

                   return Integer.compare(d1, d2);
               }
               return cmp1;
           });
           queue.add(primeList);

           while (queue.size() > 0) {
               List<String> curr = queue.remove();
               if (curr.size() > limit) {
                   continue;
               }

               String last = curr.get(curr.size() - 1);
               for (String word : ws) {
                   if (distance(last, word) == 1) {
                       if (word.equals(tw)) {
                           curr.add(word);
                           System.out.println(String.join(" -> ", curr));
                           return;
                       }

                       if (!curr.contains(word)) {
                           List<String> cp = new ArrayList<>(curr);
                           cp.add(word);
                           queue.add(cp);
                       }
                   }
               }
           }
       }

       System.err.printf("Cannot turn `%s` into `%s`%n", fw, tw);
   }

   public static void main(String[] args) throws IOException {
       Map<Integer, Set<String>> words = new HashMap<>();
       for (String line : Files.readAllLines(Path.of("unixdict.txt"))) {
           Set<String> wl = words.computeIfAbsent(line.length(), HashSet::new);
           wl.add(line);
       }

       wordLadder(words, "boy", "man");
       wordLadder(words, "girl", "lady");
       wordLadder(words, "john", "jane");
       wordLadder(words, "child", "adult");
       wordLadder(words, "cat", "dog");
       wordLadder(words, "lead", "gold");
       wordLadder(words, "white", "black");
       wordLadder(words, "bubble", "tickle", 12);
   }

}</lang>

Output:

boy -> bay -> may -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
Cannot turn `child` into `adult`
cat -> cot -> dot -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> waggle -> wangle -> tangle -> tingle -> tinkle -> tickle

Faster alternative

Translation of: C++

<lang java>import java.io.*; import java.util.*;

public class WordLadder {

   public static void main(String[] args) {
       try {
           Map<Integer, List<String>> words = new HashMap<>();
           try (BufferedReader reader = new BufferedReader(new FileReader("unixdict.txt"))) {
               String line;
               while ((line = reader.readLine()) != null)
                   words.computeIfAbsent(line.length(), k -> new ArrayList<String>()).add(line);
           }
           wordLadder(words, "boy", "man");
           wordLadder(words, "girl", "lady");
           wordLadder(words, "john", "jane");
           wordLadder(words, "child", "adult");
           wordLadder(words, "cat", "dog");
           wordLadder(words, "lead", "gold");
           wordLadder(words, "white", "black");
           wordLadder(words, "bubble", "tickle");
       } catch (Exception e)  {
           e.printStackTrace();
       }   
   }

   // Returns true if strings s1 and s2 differ by one character.
   private static boolean oneAway(String s1, String s2) {
       if (s1.length() != s2.length())
           return false;
       boolean result = false;
       for (int i = 0, n = s1.length(); i != n; ++i) {
           if (s1.charAt(i) != s2.charAt(i)) {
               if (result)
                   return false;
               result = true;
           }
       }
       return result;
   }

   // If possible, print the shortest chain of single-character modifications that
   // leads from "from" to "to", with each intermediate step being a valid word.
   // This is an application of breadth-first search.
   private static void wordLadder(Map<Integer, List<String>> words, String from, String to) {
       List<String> w = words.get(from.length());
       if (w != null) {
           Deque<String> poss = new ArrayDeque<>(w);
           Deque<String> f = new ArrayDeque<String>();
           f.add(from);
           Deque<Deque<String>> queue = new ArrayDeque<>();
           queue.add(f);
           while (!queue.isEmpty()) {
               Deque<String> curr = queue.poll();
               for (Iterator<String> i = poss.iterator(); i.hasNext(); ) {
                   String str = i.next();
                   if (!oneAway(str, curr.getLast()))
                       continue;
                   if (to.equals(str)) {
                       curr.add(to);
                       System.out.println(String.join(" -> ", curr));
                       return;
                   }
                   Deque<String> temp = new ArrayDeque<>(curr);
                   temp.add(str);
                   queue.add(temp);
                   i.remove();
               }
           }
       }
       System.out.printf("%s into %s cannot be done.\n", from, to);
   }

}</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle

jq

Translation of: Wren

Works with: jq

Works with gojq, the Go implementation of jq <lang jq>def count(stream): reduce stream as $i (0; .+1);

def words: [inputs]; # one way to read the word list

def oneAway($a; $b):

 ($a|explode) as $ax
 | ($b|explode) as $bx
 | 1 == count(range(0; $a|length) | select($ax[.] != $bx[.]));

input: the word list

def wordLadder($a; $b):

   ($a|length) as $len
   | { poss: map(select(length == $len)),      # the relevant words
       todo:  $a                           # possible chains
     }
   | until ( ((.todo|length) == 0) or .solution;
       .curr = .todo[0]
       | .todo |= .[1:]

| .curr[-1] as $c

       | (.poss | map(select( oneAway(.; $c) ))) as $next
       | if ($b | IN($next[]))
         then .curr += [$b]
         | .solution = (.curr|join(" -> ")) 
         else .poss = (.poss - $next)

| .curr as $curr

         | .todo = (reduce range(0; $next|length) as $i (.todo;
                      . + [$curr + [$next[$i] ]] ))
         end )
   | if .solution then .solution
     else "There is no ladder from \($a) to \($b)."
     end ;

def pairs:

   ["boy", "man"],
   ["girl", "lady"],
   ["john", "jane"],
   ["child", "adult"],
   ["word", "play"]

words | pairs as $p | wordLadder($p[0]; $p[1])</lang>

Output:

Invocation: jq -nr -R -f word-ladder.jq unixdict.txt

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
There is no ladder from child to adult.
word -> ford -> form -> foam -> flam -> clam -> clay -> play

Julia

<lang julia>const dict = Set(split(read("unixdict.txt", String), r"\s+"))

function targeted_mutations(str::AbstractString, target::AbstractString)

   working, tried = str, Set{String}()
   while all(a -> a[end] != target, working)
       newworking = Vector{Vector{String}}()
       for arr in working
           s = arr[end]
           push!(tried, s)
           for j in 1:length(s), c in 'a':'z'
               w = s[1:j-1] * c * s[j+1:end]
               if w in dict && !(w in tried)
                   push!(newworking, [arr; w])
               end
           end
       end
       isempty(newworking) && return "This cannot be done."
       working = newworking
   end
   return filter(a -> a[end] == target, working)

end

println("boy to man: ", targeted_mutations("boy", "man")) println("girl to lady: ", targeted_mutations("girl", "lady")) println("john to jane: ", targeted_mutations("john", "jane")) println("child to adult: ", targeted_mutations("child", "adult"))

</lang>

Output:

boy to man: [["boy", "bay", "may", "man"], ["boy", "bay", "ban", "man"], ["boy", "bon", "ban", "man"]]
girl to lady: [["girl", "gill", "gall", "gale", "gaze", "laze", "lazy", "lady"]]
john to jane: [["john", "cohn", "conn", "cone", "cane", "jane"]]
child to adult: [["This cannot be done."]]

Mathematica / Wolfram Language

This example is incorrect. Please fix the code and remove this message.

Details: The requirement is to find the shortest path other examples do John to Jane with 4 intermediate words. Also an impossible example is required: child to adult.

<lang Mathematica>db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[3]]]]]; sel=Select[Subsets[db,{2}],HammingDistance[#1,#2]==1&]; g=Graph[db,UndirectedEdge@@@sel]; FindShortestPath[g,"boy","man"]

db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[4]]]]]; sel=Select[Subsets[db,{2}],HammingDistance[#1,#2]==1&]; g=Graph[db,UndirectedEdge@@@sel]; FindShortestPath[g,"girl","lady"] FindShortestPath[g,"john","jane"]

db=DeleteDuplicates[RemoveDiacritics[ToLowerCase[Select[DictionaryLookup[],StringLength/*EqualTo[5]]]]]; sel=Select[Subsets[db,{2}],HammingDistance[#1,#2]==1&]; g=Graph[db,UndirectedEdge@@@sel]; FindShortestPath[g,"child","adult"]</lang>

Output:

{"boy", "bay", "ban", "man"}
{"girl", "gill", "gall", "gals", "gads", "lads", "lady"}
{"john", "join", "jain", "main", "mann", "mane", "jane"}
{}

Nim

<lang Nim>import sets, strformat, strutils

func isOneAway(word1, word2: string): bool =

 ## Return true if "word1" and "word2" has only one letter of difference.
 for i in 0..word1.high:
   if word1[i] != word2[i]:
     if result: return false   # More than one letter of difference.
     else: result = true       # One letter of difference, for now.

var words: array[1..22, HashSet[string]] # Set of words sorted by length.

for word in "unixdict.txt".lines:

 words[word.len].incl word

proc path(start, target: string): seq[string] =

 ## Return a path from "start" to "target" or an empty list
 ## if there is no possible path.
 let lg = start.len
 doAssert target.len == lg, "Source and destination must have same length."
 doAssert start in words[lg], "Source must exist in the dictionary."
 doAssert target in words[lg], "Destination must exist in the dictionary."

 var currPaths = @[@[start]]         # Current list of paths found.
 var pool = words[lg]                # List of possible words to use.

 while true:
   var newPaths: seq[seq[string]]    # Next list of paths.
   var added: HashSet[string]        # Set of words added during the round.
   for candidate in pool:
     for path in currPaths:
       if candidate.isOneAway(path[^1]):
         let newPath = path & candidate
         if candidate == target:
           # Found a path.
           return newPath
         else:
           # Not the target. Add a new path.
           newPaths.add newPath
           added.incl candidate
           break
   if newPaths.len == 0: break       # No path.
   currPaths = move(newPaths)        # Update list of paths.
   pool.excl added                   # Remove added words from pool.

when isMainModule:

 for (start, target) in [("boy", "man"), ("girl", "lady"), ("john", "jane"),
                         ("child", "adult"), ("cat", "dog"), ("lead", "gold"),
                         ("white", "black"), ("bubble", "tickle")]:
   let path = path(start, target)
   if path.len == 0:
     echo &"No path from “{start}” to “{target}”."
   else:
     echo path.join(" → ")</lang>

Output:

boy → bon → ban → man
girl → gill → gall → gale → gaze → laze → lazy → lady
john → cohn → conn → cone → cane → jane
No path from “child” to “adult”.
cat → cot → cog → dog
lead → load → goad → gold
white → whine → chine → chink → clink → clank → blank → black
bubble → babble → gabble → garble → gargle → gaggle → waggle → wangle → tangle → tingle → tinkle → tickle

Perl

Direct translation

Translation of: C++

<lang perl>use strict; use warnings;

my %dict;

open my $handle, '<', 'unixdict.txt'; while (my $word = <$handle>) {

   chomp($word);
   my $len = length $word;
   if (exists $dict{$len}) {
       push @{ $dict{ $len } }, $word;
   } else {
       my @words = ( $word );
       $dict{$len} = \@words;
   }

} close $handle;

sub distance {

   my $w1 = shift;
   my $w2 = shift;

   my $dist = 0;
   for my $i (0 .. length($w1) - 1) {
       my $c1 = substr($w1, $i, 1);
       my $c2 = substr($w2, $i, 1);
       if (not ($c1 eq $c2)) {
           $dist++;
       }
   }
   return $dist;

}

sub contains {

   my $aref = shift;
   my $needle = shift;

   for my $v (@$aref) {
       if ($v eq $needle) {
           return 1;
       }
   }

   return 0;

}

sub word_ladder {

   my $fw = shift;
   my $tw = shift;

   if (exists $dict{length $fw}) {
       my @poss = @{ $dict{length $fw} };
       my @queue = ([$fw]);
       while (scalar @queue > 0) {
           my $curr_ref = shift @queue;
           my $last = $curr_ref->[-1];

           my @next;
           for my $word (@poss) {
               if (distance($last, $word) == 1) {
                   push @next, $word;
               }
           }

           if (contains(\@next, $tw)) {
               push @$curr_ref, $tw;
               print join (' -> ', @$curr_ref), "\n";
               return;
           }

           for my $word (@next) {
               for my $i (0 .. scalar @poss - 1) {
                   if ($word eq $poss[$i]) {
                       splice @poss, $i, 1;
                       last;
                   }
               }
           }

           for my $word (@next) {
               my @temp = @$curr_ref;
               push @temp, $word;

               push @queue, \@temp;
           }
       }
   }

   print STDERR "Cannot change $fw into $tw\n";

}

word_ladder('boy', 'man'); word_ladder('girl', 'lady'); word_ladder('john', 'jane'); word_ladder('child', 'adult'); word_ladder('cat', 'dog'); word_ladder('lead', 'gold'); word_ladder('white', 'black'); word_ladder('bubble', 'tickle');</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
Cannot change child into adult
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle

Idiomatic version

Exactly the same algorithm, written in a more Perl-ish style. Is this better, or worse? Maybe both. Interestingly, runs 1/3-rd faster. <lang perl>use strict; use warnings; use feature 'say';

my %dict; open my $handle, '<', 'ref/unixdict.txt'; while (my $word = <$handle>) {

   chomp $word;
   my $l = length $word;
   if ($dict{$l}) { push @{ $dict{$l} },    $word   }
   else           {         $dict{$l} = \@{[$word]} }

} close $handle;

sub distance {

   my($w1,$w2) = @_;
   my $d;
   substr($w1, $_, 1) eq substr($w2, $_, 1) or $d++ for 0 .. length($w1) - 1;
   return $d // 0;

}

sub contains {

   my($aref,$needle) = @_;
   $needle eq $_ and return 1 for @$aref;
   return 0;

}

sub word_ladder {

   my($fw,$tw) = @_;
   say 'Nothing like that in dictionary.' and return unless $dict{length $fw};

   my @poss  = @{ $dict{length $fw} };
   my @queue = [$fw];
   while (@queue) {
       my $curr_ref = shift @queue;
       my $last     = $curr_ref->[-1];

       my @next;
       distance($last, $_) == 1 and push @next, $_ for @poss;
       push(@$curr_ref, $tw) and say join ' -> ', @$curr_ref and return if contains \@next, $tw;

       for my $word (@next) {
           $word eq $poss[$_] and splice(@poss, $_, 1) and last for 0 .. @poss - 1;
       }
       push @queue, \@{[@{$curr_ref}, $_]} for @next;
   }

   say "Cannot change $fw into $tw";

}

word_ladder(split) for 'boy man', 'girl lady', 'john jane', 'child adult';</lang> Same style output.

Phix

with javascript_semantics
sequence words = unix_dict()

function right_length(string word, integer l) return length(word)=l end function

function one_away(string a, b) return sum(sq_ne(a,b))=1 end function

function dca(sequence s, n) return append(deep_copy(s),n) end function

procedure word_ladder(string a, b)
    sequence poss = filter(words,right_length,length(a)),
             todo = {{a}}, 
             curr -- aka todo[1], word chain starting from a
    while length(todo) do
        {curr,todo} = {todo[1],todo[2..$]}
        sequence next = filter(poss,one_away,curr[$])
        if find(b,next) then
            printf(1,"%s\n",{join(append(deep_copy(curr),b),"->")})
            return
        end if
        poss = filter(poss,"out",next)
        todo &= apply(true,dca,{{curr},next})
    end while
    printf(1,"%s into %s cannot be done\n",{a,b})
end procedure
word_ladder("boy","man")
word_ladder("girl","lady")
word_ladder("john","jane")
word_ladder("child","adult")

Aside: an initial poss = filter(poss,"out",{a}) might be prudent, but would only prevent a single next:={} step, at about the same cost as the initial filter anyway.

Output:

boy->bay->ban->man
girl->gill->gall->gale->gaze->laze->lazy->lady
john->cohn->conn->cone->cane->jane
child into adult cannot be done

Python

The function cache is not part of the algorithm but avoid re-download and map re-computing at each re-run. <lang python>import os,sys,zlib,urllib.request

def h ( str,x=9 ):

   for c in str :
       x = ( x*33 + ord( c )) & 0xffffffffff
   return x

def cache ( func,*param ):

   n = 'cache_%x.bin'%abs( h( repr( param )))
   try    : return eval( zlib.decompress( open( n,'rb' ).read()))
   except : pass
   s = func( *param )
   open( n,'wb' ).write( zlib.compress( bytes( repr( s ),'ascii' )))
   return s

dico_url = 'https://raw.githubusercontent.com/quinnj/Rosetta-Julia/master/unixdict.txt' read_url = lambda url : urllib.request.urlopen( url ).read() load_dico = lambda url : tuple( cache( read_url,url ).split( b'\n')) isnext = lambda w1,w2 : len( w1 ) == len( w2 ) and len( list( filter( lambda l : l[0]!=l[1] , zip( w1,w2 )))) == 1

def build_map ( words ):

   map = [(w.decode('ascii'),[]) for w in words]
   for i1,(w1,n1) in enumerate( map ):
       for i2,(w2,n2) in enumerate( map[i1+1:],i1+1 ):
           if isnext( w1,w2 ):
               n1.append( i2 )
               n2.append( i1 )
   return map

def find_path ( words,w1,w2 ):

   i = [w[0] for w in words].index( w1 )
   front,done,res  = [i],{i:-1},[]
   while front :
       i = front.pop(0)
       word,next = words[i]
       for n in next :
           if n in done : continue
           done[n] = i
           if words[n][0] == w2 :
               while n >= 0 :
                   res = [words[n][0]] + res
                   n = done[n]
               return ' '.join( res )
           front.append( n )
   return '%s can not be turned into %s'%( w1,w2 )

for w in ('boy man','girl lady','john jane','alien drool','child adult'):

   print( find_path( cache( build_map,load_dico( dico_url )),*w.split()))</lang>

Output:

boy bay ban man
girl gill gall gale gaze laze lazy lady
john cohn conn cone cane jane
alien alden alder alter aster ester eater bater bator baton baron boron moron moran moral morel monel money monty month mouth south sooth sloth slosh slash flash flask flank blank bland blend bleed breed bread tread triad trial trill drill droll drool
child can not be turned into adult

Racket

<lang racket>#lang racket

(define *unixdict* (delay (with-input-from-file "../../data/unixdict.txt"

                           (compose list->set port->lines))))

(define letters-as-strings (map string (string->list "abcdefghijklmnopqrstuvwxyz")))

(define ((replace-for-c-at-i w i) c)

 (string-append (substring w 0 i) c (substring w (add1 i))))

(define (candidates w)

 (for*/list (((i w_i) (in-parallel (string-length w) w))
             (r (in-value (replace-for-c-at-i w i)))
             (c letters-as-strings)
             #:unless (char=? w_i (string-ref c 0)))
   (r c)))

(define (generate-candidates word.path-hash)

 (for*/hash (((w p) word.path-hash)
             (w′ (candidates w)))
   (values w′ (cons w p))))

(define (hash-filter-keys keep-key? h)

 (for/hash (((k v) h) #:when (keep-key? k)) (values k v)))

(define (Word-ladder src dest (words (force *unixdict*)))

 (let loop ((edge (hash src null)) (unused (set-remove words src)))
   (let ((cands (generate-candidates edge)))
     (if (hash-has-key? cands dest)
         (reverse (cons dest (hash-ref cands dest)))
         (let ((new-edge (hash-filter-keys (curry set-member? unused) cands)))
           (if (hash-empty? new-edge)
               `(no-path-between ,src ,dest)
               (loop new-edge (set-subtract unused (list->set (hash-keys new-edge))))))))))

(module+ main

 (Word-ladder "boy" "man")
 (Word-ladder "girl" "lady")
 (Word-ladder "john" "jane")
 (Word-ladder "alien" "drool")
 (Word-ladder "child" "adult"))</lang>

Output:

'("boy" "bay" "may" "man")
'("girl" "gill" "gall" "gale" "gaze" "laze" "lazy" "lady")
'("john" "cohn" "conn" "cone" "cane" "jane")
'("alien"
  "alden"
  "alder"
  "alter"
  "aster"
  "ester"
  "eater"
  "bater"
  "bator"
  "baton"
  "baron"
  "boron"
  "moron"
  "moran"
  "moral"
  "morel"
  "monel"
  "money"
  "monty"
  "month"
  "mouth"
  "south"
  "sooth"
  "sloth"
  "slosh"
  "slash"
  "flash"
  "flask"
  "flank"
  "blank"
  "bland"
  "blend"
  "bleed"
  "breed"
  "bread"
  "tread"
  "triad"
  "trial"
  "trill"
  "drill"
  "droll"
  "drool")
'(no-path-between "child" "adult")

Raku

<lang perl6>constant %dict = 'unixdict.txt'.IO.lines

                              .classify(*.chars)
                              .map({ .key => .value.Set });

sub word_ladder ( Str $from, Str $to ) {

   die if $from.chars != $to.chars;

   my $sized_dict = %dict{$from.chars};
   
   my @workqueue = (($from,),);
   my $used = ($from => True).SetHash;
   while @workqueue {
       my @new_q;
       for @workqueue -> @words {
           my $last_word = @words.tail;
           my @new_tails = gather for 'a' .. 'z' -> $replacement_letter {
               for ^$last_word.chars -> $i {
                   my $new_word = $last_word;
                   $new_word.substr-rw($i, 1) = $replacement_letter;

                   next unless $new_word ∈ $sized_dict
                       and not $new_word ∈ $used;
                   take $new_word;
                   $used{$new_word} = True;
                   
                   return |@words, $new_word if $new_word eq $to;
               }
           }
           push @new_q, ( |@words, $_ ) for @new_tails;
       }
       @workqueue = @new_q;
   }

} for <boy man>, <girl lady>, <john jane>, <child adult> -> ($from, $to) {

   say word_ladder($from, $to)
       // "$from into $to cannot be done";

}</lang>

Output:

(boy bay may man)
(girl gill gall gale gaze laze lazy lady)
(john cohn conn cone cane jane)
child into adult cannot be done

REXX

This REXX entry does a little more error checking.

It also assumes that the dictionary file is in mixed case as well as the words entered on the CL.

To treat the dictionary and input words as caseless, all words are translated to lowercase.

Programming note: this REXX program uses the lower BIF which Regina has).
If your REXX doesn't support that BIF, here is an equivalent function: <lang rexx>lower: procedure; parse arg a; @= 'abcdefghijklmnopqrstuvwxyz'; @u= @; upper @u

                  return translate(a, @, @u)</lang>

<lang rexx>/*REXX program finds words (within an identified dict.) to solve a word ladder puzzle.*/ parse arg base targ iFID . /*obtain optional arguments from the CL*/ if base== | base=="," then base= 'boy' /*Not specified? Then use the default.*/ if targ== | targ=="," then targ= 'man' /* " " " " " " */ if iFID== | iFID=="," then iFID='unixdict.txt' /* " " " " " " */ abc= 'abcdefghijklmnopqrstuvwxyz' /*the lowercase (Latin) alphabet. */ abcU= abc; upper abcU /* " uppercase " " */ base= lower(base); targ= lower(targ) /*lowercase the BASE and also the TARG.*/

  L= length(base)                               /*length of the BASE  (in characters). */

if L<2 then call err 'base word is too small or missing' /*oops, too small*/ if length(targ)\==L then call msg , "target word isn't the same length as the base word" call letters /*assign letters, faster than SUBSTR. */

= 0 /*# of words whose length matches BASE.*/

@.= /*default value of any dictionary word.*/

        do recs=0  while lines(iFID)\==0        /*read each word in the file  (word=X).*/
        x= lower(strip( linein( iFID) ) )       /*pick off a word from the input line. */
        if length(x)\==L  then iterate          /*Word not correct length?  Then skip. */
        #= # + 1;         @.x= 1                /*bump # words with length L; semaphore*/
        end   /*recs*/                          /* [↑]   semaphore name is uppercased. */

!.= 0 say copies('─', 30) recs "words in the dictionary file: " iFID say copies('─', 30) # "words in the dictionary file of length: " L say copies('─', 30) ' base word is: ' base say copies('─', 30) 'target word is: ' targ rung= targ $= base

          do f=1  for m;    call look;  if result\==  then leave      /*Found?  Quit.*/
          end   /*f*/

say if f>m then call msg 'no word ladder solution possible for ' base " ──► " targ

              do f-2;       $= base;    !.= 0   /*process all the rungs that were found*/
                do forever; call look;  if result\==  then leave      /*Found?  Quit.*/
                end   /*forever*/
              end     /*f-2*/

call show words(rung) exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ msg: say; if arg()==2 then say '***error*** ' arg(2); else say arg(1); say; exit 13 show: say 'a solution: ' base; do j=1 to arg(1); say left(,12) word(rung,j); end; return letters: do m=1 for length(abc); a.m= substr(abc, m, 1); end; return /*──────────────────────────────────────────────────────────────────────────────────────*/ look: procedure expose @. !. a. $ abc base L rung targ search; rungs= word(rung, 1)

     $$=;                                                            rung#= words(rungs)
             do i=1  for words($);                  y= word($, i);     !.y= 1
                do k=1  for L
                   do n=1  for 26;  z= overlay(a.n, y, k)             /*change a letter*/
                   if @.z==  then iterate       /*Is this not a word?  Then skip it. */
                   if !.z      then iterate       /* "   "   a  repeat?    "    "   "  */
                   if z==rungs then rung= y rung  /*prepend a word to the rung list.   */
                   if z==rungs & rung#>1  then return z               /*short─circuit. */
                   if z==targ  then return z
                   $$= $$ z                       /*append a possible ladder word to $$*/
                   end   /*n*/
                end      /*k*/
             end         /*i*/
     $= $$;                         return </lang>

output when using the default inputs:

────────────────────────────── 25104 words in the dictionary file:  unixdict.txt
────────────────────────────── 796 words in the dictionary file of length:  3
──────────────────────────────  base  word is:  boy
────────────────────────────── target word is:  man

a solution:  boy
             bay
             may
             man

output when using the inputs of: girl lady

────────────────────────────── 25104 words in the dictionary file:  unixdict.txt
────────────────────────────── 2187 words in the dictionary file of length:  4
──────────────────────────────  base  word is:  girl
────────────────────────────── target word is:  lady

a solution:  girl
             gill
             gall
             gale
             gaze
             laze
             lazy
             lady

output when using the inputs of: john jane

────────────────────────────── 25104 words in the dictionary file:  unixdict.txt
────────────────────────────── 2187 words in the dictionary file of length:  4
──────────────────────────────  base  word is:  john
────────────────────────────── target word is:  jane

a solution:  john
             cohn
             conn
             cone
             cane
             jane

output when using the inputs of: child adult

────────────────────────────── 25104 words in the dictionary file:  unixdict.txt
────────────────────────────── 3161 words in the dictionary file of length:  5
──────────────────────────────  base  word is:  child
────────────────────────────── target word is:  adult

no word ladder solution possible for  child  ──►  adult

Ruby

Translation of: Raku

<lang ruby>require "set"

Words = File.open("unixdict.txt").read.split("\n").

 group_by { |w| w.length }.map { |k, v| [k, Set.new(v)] }.
 to_h

def word_ladder(from, to)

 raise "Length mismatch" unless from.length == to.length
 sized_words = Words[from.length]
 work_queue = from
 used = Set.new [from]
 while work_queue.length > 0
   new_q = []
   work_queue.each do |words|
     last_word = words[-1]
     new_tails = Enumerator.new do |enum|
       ("a".."z").each do |replacement_letter|
         last_word.length.times do |i|
           new_word = last_word.clone
           new_word[i] = replacement_letter
           next unless sized_words.include? new_word and
                       not used.include? new_word
           enum.yield new_word
           used.add new_word
           return words + [new_word] if new_word == to
         end
       end
     end
     new_tails.each do |t|
       new_q.push(words + [t])
     end
   end
   work_queue = new_q
 end

end

[%w<boy man>, %w<girl lady>, %w<john jane>, %w<child adult>].each do |from, to|

 if ladder = word_ladder(from, to)
   puts ladder.join " → "
 else
   puts "#{from} into #{to} cannot be done"
 end

end</lang>

Output:

boy → bay → may → man                                                                                                                        
girl → gill → gall → gale → gaze → laze → lazy → lady                                                                                        
john → cohn → conn → cone → cane → jane                                                                                                      
child into adult cannot be done

Swift

Translation of: Wren

<lang swift>import Foundation

func oneAway(string1: [Character], string2: [Character]) -> Bool {

   if string1.count != string2.count {
       return false
   }
   var result = false
   var i = 0
   while i < string1.count {
       if string1[i] != string2[i] {
           if result {
               return false
           }
           result = true
       }
       i += 1
   }
   return result

}

func wordLadder(words: Character, from: String, to: String) {

   let fromCh = Array(from)
   let toCh = Array(to)
   var poss = words.filter{$0.count == fromCh.count}
   var queue: [[[Character]]] = fromCh
   while !queue.isEmpty {
       var curr = queue[0]
       let last = curr[curr.count - 1]
       queue.removeFirst()
       let next = poss.filter{oneAway(string1: $0, string2: last)}
       if next.contains(toCh) {
           curr.append(toCh)
           print(curr.map{String($0)}.joined(separator: " -> "))
           return
       }
       poss.removeAll(where: {next.contains($0)})
       for str in next {
           var temp = curr
           temp.append(str)
           queue.append(temp)
       }
   }
   print("\(from) into \(to) cannot be done.")

}

do {

   let words = try String(contentsOfFile: "unixdict.txt", encoding: String.Encoding.ascii)
       .components(separatedBy: "\n")
       .filter{!$0.isEmpty}
       .map{Array($0)}
   wordLadder(words: words, from: "man", to: "boy")
   wordLadder(words: words, from: "girl", to: "lady")
   wordLadder(words: words, from: "john", to: "jane")
   wordLadder(words: words, from: "child", to: "adult")
   wordLadder(words: words, from: "cat", to: "dog")
   wordLadder(words: words, from: "lead", to: "gold")
   wordLadder(words: words, from: "white", to: "black")
   wordLadder(words: words, from: "bubble", to: "tickle")

} catch {

   print(error.localizedDescription)

}</lang>

Output:

man -> ban -> bay -> boy
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.
cat -> cot -> cog -> dog
lead -> load -> goad -> gold
white -> whine -> chine -> chink -> clink -> blink -> blank -> black
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle

Wren

Translation of: Phix

Library: Wren-sort

<lang ecmascript>import "io" for File import "/sort" for Find

var words = File.read("unixdict.txt").trim().split("\n")

var oneAway = Fn.new { |a, b|

   var sum = 0
   for (i in 0...a.count) if (a[i] != b[i]) sum = sum + 1
   return sum == 1

}

var wordLadder = Fn.new { |a, b|

   var l = a.count
   var poss = words.where { |w| w.count == l }.toList
   var todo = a
   while (todo.count > 0) {
       var curr = todo[0]
       todo = todo[1..-1]
       var next = poss.where { |w| oneAway.call(w, curr[-1]) }.toList
       if (Find.first(next, b) != -1) {
           curr.add(b)
           System.print(curr.join(" -> "))
           return
       }
       poss = poss.where { |p| !next.contains(p) }.toList
       for (i in 0...next.count) {
           var temp = curr.toList
           temp.add(next[i])
           todo.add(temp)
       }
   }
   System.print("%(a) into %(b) cannot be done.")

}

var pairs = [

   ["boy", "man"],
   ["girl", "lady"],
   ["john", "jane"],
   ["child", "adult"]

] for (pair in pairs) wordLadder.call(pair[0], pair[1])</lang>

Output:

boy -> bay -> ban -> man
girl -> gill -> gall -> gale -> gaze -> laze -> lazy -> lady
john -> cohn -> conn -> cone -> cane -> jane
child into adult cannot be done.