Word Ladders

Find how to get from one word to another through a ladder of words that each differ by one letter.

Run the code to get a list of dictionary words that start with z and have four letters. Get words that have other patterns of letters (e.g. start with a, then have four letters):

SHOW/HIDE DETAILS

Get a list of all dictionary words in English:

DictionaryLookup[]

Get a list of words that match the pattern of starting with z and then having 3 more letters:

DictionaryLookup["z" ~~ _ ~~ _ ~~ _]

HIDE DETAILS
DictionaryLookup["z" ~~ _ ~~ _ ~~ _]

Find the five words that are nearest to elephant. Try out different words and see which other words are nearest (e.g. try your name):

Note: upper and lower case are considered different.

SHOW/HIDE DETAILS

This finds 5 words nearest to elephant, based on changing the fewest letters:

Nearest[DictionaryLookup[], "elephant", 5]

HIDE DETAILS
Nearest[DictionaryLookup[], "elephant", 5]

Find all the words that differ from fish by one letter. Try out different words to find words that differ from them by one letter (e.g. try your name):

Note: longer words may have no nearby other words.

SHOW/HIDE DETAILS

This finds all the words in the dictionary that differ from fish by at most 1 letter:

Nearest[DictionaryLookup[], "fish", {All, 1}]

Use Rest to keep the rest of the list, dropping the original word:

Rest[Nearest[DictionaryLookup[], "fish", {All, 1}]]

HIDE DETAILS
Rest[Nearest[DictionaryLookup[], "fish", {All, 1}]]

Make a network. Try making networks using different numbers than 2, 1, and 10:

SHOW/HIDE DETAILS

Were going to want to create networks of words. Lets start by creating a network of numbers.

This defines a particular way to connect numbers from 0 to 9:

Table[n -> Mod[2 n + 1, 10], {n, 0, 9}]

Graph draws a network or graph; VertexLabels->Name says to label vertices with their names:

Graph[Table[n -> Mod[2 n + 1, 10], {n, 0, 9}], VertexLabels -> "Name"]

HIDE DETAILS
Graph[Table[n -> Mod[2 n + 1, 10], {n, 0, 9}], VertexLabels -> "Name"]

Make a network of words that differ by one letter. Try making networks for different classes of words (e.g. words beginning with w instead of q):

Note: this will take a long time if your class of words is big.

SHOW/HIDE DETAILS

This creates a list of words that are going to be in the network, here consisting of q followed by 3 letters:

words = DictionaryLookup["q" ~~ _ ~~ _ ~~ _]

Were naming this list words.

Now we construct a function that finds nearest words:

nf = Nearest[words]

We can apply this function to any word in the list, saying we want all words that differ by at most 1 letter:

nf["quad", {All, 1}]

Use Rest to keep only the rest of the list, dropping the first element (which is here the original word):

Rest[nf["quad", {All, 1}]]

To find the whole network, we need to apply this to every word in the list:

# -> Rest[nf[#, {All, 1}]] & /@ words

The # and & set up a pure function, which is then mapped over the original list of words.

To form the actual network, we need to thread these connections. Thread turns a connection to a list into a list of connectionsfor example:

Thread["one" -> {"two", "three"}]

Thread the nearest connections:

Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words

Then flatten out all the sublists:

Flatten[Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words]

Now we can turn this into a graph, or network:

Graph[Flatten[Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words], VertexLabels -> "Name"]

HIDE DETAILS
words = DictionaryLookup["q" ~~ _ ~~ _ ~~ _]; nf = Nearest[words]; Graph[ Flatten[Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words], VertexLabels -> "Name"]

Run the first expression to set up a network of words with four letters. Then try some different words with four letters in the second expression (e.g. pigs or nose) to find word ladders between them:

Note: the words need to be in the dictionary.

SHOW/HIDE DETAILS

This creates a network (named g) of nearest words for all 4-letter dictionary words (note that theres a semicolon at the end to avoid printing the very big result):

words = DictionaryLookup[_ ~~ _ ~~ _ ~~ _]; nf = Nearest[words]; g = Graph[Flatten[Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words]];

This finds the shortest path on the network from fish to fowla word ladder:

FindShortestPath[g, "fish", "fowl"]

HIDE DETAILS
words = DictionaryLookup[_ ~~ _ ~~ _ ~~ _]; nf = Nearest[words]; g = Graph[Flatten[Thread[# -> Rest[nf[#, {All, 1}]]] & /@ words]];

Run this after youve run the previous expression:

FindShortestPath[g, "fish", "fowl"]