Word Exploration

Simeon Buttery

How likely would it be to generate an actual word from random letters?

Today, we will be exploring a random string of letters and how they correspond to actual words in the English dictionary.

Words with a Q, but not a U

Before tackling this main question, lets first try a simpler example.
(This example is from an Estimathon at a Join Mathematics Meeting that Mrs. Brown attended)

“Estimate the number of legal Scrabble words that contain a Q but not a U.”

According to google, there should be 32. Lets try to get there with the Wolfram Language.
First, lets get a sense of what word list looks like.

Take[WordList[],{20000,20050}]

So there’s a lot of words with the same base, but overall, what are some random words?

RandomSample[WordList[],100]

Ok, so going back to the question, we want to find a list of all the words with a q.
To do this, we need to check if a word has a q. We can do this with MemberQ.

MemberQ[{1,2,3,4,5,6},3]

MemberQ[{1,2,3,4,5,6},8]

MemberQ[Characters["question"],"q"]

MemberQ[Characters["potato"],"q"]

Once we’ve determined if our word has a q, we need some outputs.

If[MemberQ[Characters["question"],"q"],"it has a q","it doesnt have a q"]

Now that we have outputs depending of the word, we want to add that word to a list if it does have a q.
First lets set up a list and our test words.

qlist={};
testword1=Characters["question"];
testword2=Characters["potato"];

Then, we can test to see if the word has a q, and if so, add it to the list

If[MemberQ[testword1,"q"],"it has a q","it doesnt have a q"]

If[MemberQ[testword1,"q"],qlist=Append[qlist,testword1],qlist=qlist]

Now, we just need to map this function over all the words in wordlist, not just our test words.
I’ll also add our qlist defining to this line of code too so it resets every time we evaluate it.
Finally, we can suppress the output of our testing function and join and display all the words with a q.

qlist={};
Map[If[MemberQ[#,"q"],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[StringJoin,qlist]

This is pretty long, 614 words to be exact.

Length[qlist]

With the same logic as above, we can find the words in qlist that do not have a u, except with a Not@MemberQ.

noulist={};
Map[If[Not@MemberQ[#,"u"],noulist=Append[noulist,#],noulist=noulist]&,qlist];
Map[StringJoin,noulist]

Um, there isn’t any... Is something wrong with the code? 
First, lets put it all together in one cell.

qlist={};noulist={};
Map[If[MemberQ[#,"q"],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[If[Not@MemberQ[#,"u"],noulist=Append[noulist,#],noulist=noulist]&,qlist];
Map[StringJoin,noulist]

There doesn’t seem to be any mistakes...
Lets try different letters, say q words without an e.

qlist={};noulist={};
Map[If[MemberQ[#,"q"],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[If[Not@MemberQ[#,"e"],noulist=Append[noulist,#],noulist=noulist]&,qlist];
Map[StringJoin,noulist]

Is this taking out any words? Lets compare the lengths.

Length[qlist]
Length[noulist]

Yes, this is definitely taking all of the words with an e.

The problem must be that the wolfram language’s data repository doesn’t have all the words in the English language.
Well, we’ll work with what we have.

Randomly Generating Actual Words

Now that we have an understanding of WordList, lets move back to our original question, that being...

“How likely would it be to generate an actual word from random letters?”

Lets start with 5 letter words. To do this, we need to join 5 random letters of the alphabet together.

StringJoin[RandomSample[Alphabet[],5]]

Now, we can just get 100 of these using table.

Table[StringJoin[RandomSample[Alphabet[],5]],100]

Next, we need to test each string to see if it is a word. We’ll be using DictionaryWordQ for this.

DictionaryWordQ["potato"]

DictionaryWordQ["potatotato"]

Map[DictionaryWordQ,Table[StringJoin[RandomSample[Alphabet[],5]],100]]

Oh. None of them are words. To simplify this output, lets count all the ones which are true.

Count[Map[DictionaryWordQ,Table[StringJoin[RandomSample[Alphabet[],5]],100]],True]

Now that we have a simpler output, we can increase the number of words.

Count[Map[DictionaryWordQ,Table[StringJoin[RandomSample[Alphabet[],5]],10000]],True]

Nice! Some of these are words! But what words are they? In order to do this, we need to add that string to a list, if it is a word.
We will use the same structure as before.
First we need an empty list.
Then, if this string is a word, we want to add it to wdlist, and if not, we want wdlist to be the same.
Finally, we want to map this function and over our list of strings.
Remember to supress the output, and then display our wdlist.

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],5]],10000]];
wdlist

Aditionally, we can add the length of wdlist before the list itself for a little extra info.

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],5]],10000]];
Column[{Length[wdlist],wdlist}]

Now that we have our code, we can just change the number of letters.
We can try 4:

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],4]],10000]];
Column[{Length[wdlist],wdlist}]

That was a lot more words! Or we could try 3:

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],3]],10000]];
Column[{Length[wdlist],wdlist}]

Or 2:

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],2]],10000]];
Column[{Length[wdlist],wdlist}]

Wait a minute, how many 2 letter combinations are there?

26^2

676 is way less that over 2000...
Maybe its duplicating words? We can apply union to our wdlist to delete repeated elements.

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],2]],10000]];
wdlist=Union[wdlist];
Column[{Length[wdlist],wdlist}]

There we go. This should always give us 167 words due to the large sample size.
Now, what if we do 1 letter words?

wdlist={};
Map[If[DictionaryWordQ[#],wdlist=Append[wdlist,#],wdlist=wdlist]&,Table[StringJoin[RandomSample[Alphabet[],1]],10000]];
wdlist=Union[wdlist];
Column[{Length[wdlist],wdlist}]

Oh. Apparently DictionaryWordQ considers every letter its own word.

An Alphabet of Words

Going off the though of one letter words, what words sound like a single letter? Or to put it more formally:

“How many letters of the alphabet have a corresponding word that sounds like the name of a letter?”

For example, In the phrases “I see you” and “We swim in the sea”, see and sea both sound like the letter c.
So how can we answer this question with the wolfram language?
Lets try the phonetic spellings of words.

WordData["see","PhoneticForm"]

WordData["sea","PhoneticForm"]

These both give us the same thing! Nice!
Now, what are the phonetic forms of the alphabet?
So we want to map our phonetic form and over the alphabet.

Map[WordData[#,"PhoneticForm"]&,Alphabet[]]

Lets call this phonetic alphabet “alphaphon” for simplicity later on. 
This means the alphabet phonetically.

alphaphon=Map[WordData[#,"PhoneticForm"]&,Alphabet[]]

Now, we can make a list of all the words’ phonetic form!
However, this computation takes a while, so I’m going to use a smaller list with my own words until we finish it.

smallsample={"potato","car","sea","jay","math","oh","avocado"}

Now, just like with the alphabet, we can map our phonetic form and over our smallsample

Map[WordData[#,"PhoneticForm"]&,smallsample]

I have no clue what these are, so lets add the word inside the map.

Map[{#,WordData[#,"PhoneticForm"]}&,smallsample]

I’ll call this phonetic list.

phoneticlist=Map[{#,WordData[#,"PhoneticForm"]}&,smallsample]

Next, we can use the same structure as earlier from our q tester and real word tester.
First lets review part.

Part[phoneticlist,3]

phoneticlist[[3]]

phoneticlist[[3]][[2]]

Ok, so going back to our previous structure, we first need an empty list.
Then, if the phonetic form of c equals the phonetic form of our word, (which is the second part), then add it to the letterlist, but if not, the the letterlist stays the same.
Finally we want to map this function and over our phoneticlist, suppress the output, and display the letterlist.

letterlist={};
Map[If["sˈi"===#[[2]],letterlist=Append[letterlist,#],letterlist=letterlist]&,phoneticlist];
letterlist

Now this is almost there, we just want to do this for all the letters, not just the letter c.
Remember alphaphon? We can table through this for each element in alphaphon.

alphaphon

Table[
letterlist={};
Map[If[alphaphon[[n]]===#[[2]],letterlist=Append[letterlist,#],letterlist=letterlist]&,phoneticlist];
letterlist,
{n,1,26}]

Lets call this alphaanswer.

alphaanswer=Table[
letterlist={};
Map[If[alphaphon[[n]]===#[[2]],letterlist=Append[letterlist,#],letterlist=letterlist]&,phoneticlist];
letterlist,
{n,1,26}]

Now, we have all the words that sound like letters in the alphabet.
Lets format it a bit first.
So we want to riffle the alphabet in with our alphaanswer.

Riffle[Alphabet[],alphaanswer]

Then, we want to partition this into groups of two.

Partition[Riffle[Alphabet[],alphaanswer],2]

And finally we want to put it in a grid.

Grid[Partition[Riffle[Alphabet[],alphaanswer],2],Frame->All]

Now, we can just compile all of our code together.

alphaphon=Map[WordData[#,"PhoneticForm"]&,Alphabet[]];
smallsample={"potato","car","sea","jay","math","oh","avocado"};
phoneticlist=Map[{#,WordData[#,"PhoneticForm"]}&,smallsample];

alphaanswer=Table[
letterlist={};
Map[If[alphaphon[[n]]===#[[2]],letterlist=Append[letterlist,#],letterlist=letterlist]&,phoneticlist];
letterlist,
{n,1,26}];
Grid[Partition[Riffle[Alphabet[],alphaanswer],2],Frame->All]

Now for the final step, which I will not evaluate because it will take a long time.
Remove the small sample, and replace it with WordData[].

alphaphon=Map[WordData[#,"PhoneticForm"]&,Alphabet[]];
phoneticlist=Map[{#,WordData[#,"PhoneticForm"]}&,WordData[]];

alphaanswer=Table[
letterlist={};
Map[If[alphaphon[[n]]===#[[2]],letterlist=Append[letterlist,#],letterlist=letterlist]&,phoneticlist];
letterlist,
{n,1,26}];
Grid[Partition[Riffle[Alphabet[],alphaanswer],2],Frame->All]

Extra Funny Side Note

Also, you know the large bit of code that we used to find all the words with a q? (below)

qlist={};
Map[If[MemberQ[#,"q"],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[StringJoin,qlist]

Yeah, that can all be replaced by StringContainsQ.

Select[WordList[],StringContainsQ["q"]]

They’re literally the same...

Map[StringJoin,qlist]==Select[WordList[],StringContainsQ["q"]]

This just goes to show that there is usually a built in function for a given task.

However, it was still a good exercise in if logic within the Wolfram Language, so its not all to waste.

Credits

This activity is based on “Explorations with Words: A Computational Thinking Conversation” by Abby Brown in 2018.
www.abbymath.com

These notes were written for CT@TP: Computational Thinking at Torrey Pines Club January 2021.