Explorations with Words

A Computational Thinking Conversation

The following is a moderately cleaned up and later annotated version of a conversation I led with the CT@TP students during a free form, work time style meeting of our club on 01/18/18.

Original inspiration for this work came from EIWL, Chapter 11 Strings and Text, Exercise 11.24:
“Make a list of 100 random 5-letter strings.”

When reading this exercise I asked myself “How likely would it be to generate an actual word within that list?” I shared this thought with the CT@TP students and we proceeded to create the following flow of thought.

Words with Q, but no U

Before starting the 5-letter word question, I was reminded of an exercise I had shared with my classes that we had tried to answer during Estimathon! at the JMM the week before.

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

We were told the answer is 32, and I confirmed this on scrabble.hasbro.com, although other web sites have alternate lists. We thought to try using the Wolfram Language to answer this question.

WordList[]

Characters[WordList[]]

Oh! I found in the Documentation that we can generate a list of the stopwords. This was something we were interested in during the Lyrics WordCloud activity.

WordList["Stopwords"]

We wanted to get a sense of what the WordList looks like. We tried a variety of ranges.

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

RandomSample[WordList[],100]

Now let’s see if we can pull out all of the words that contain the letter “q.”

There is probably a more efficient code, but this is what I came up with at the time. (See Updates at end.) The idea is to create qlist and check the characters of each word in WordList for the letter q. If there is a letter q in a word, that word gets appended to qlist.

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

Length[qlist]

Following the logic above, I created noulist (“no u list”) and ran that across qlist, but this time checking for words that do not contain the letter “u.”

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

Hmmmm . . . Is something wrong with the code? I’m just getting a list of empty lists.

Let’s try it again, but rather than looking for q-words with no “u,” let’s try looking for q-words with no letter “a” since there certainly are some of those. (Only changed “u” to “a” below.)

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

Oops! These are lists of characters. We want the words. Use StringJoin.

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

It worked! And it’s an interesting list to read. There is no “a” among all of those words! By the way, it’s fun to run that again with “e” or “i” instead of “a.”

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]

So, if this code seems to be working properly, why are we getting an empty list { } when we do this task for “u”? It must be the WordList itself. It does not contain any words that have a “q” without a “u.” The Wolfram Language isn’t ready for Scrabble yet ☺.

Words Containing All Vowels

(This is a new pursuit while annotating these notes . . .What words contain all of the vowels?)

While reviewing my code as I write these notes, I’m reminded of a question asked once by a friend in high school: “What is the shortest word containing all of the vowels?” I remember the answer as “sequoia” and think about it every time I’m behind that model of Toyota while at a stoplight and notice the shiny silver emblem.

Can I use the code above to answer this question? Is there a “Contains” type of function in the Wolfram Language? Yup! Just typing “Conta” brings up ContainsAll and the Documentation confirms that it will do what I want. Let’s take ContainsAll for a spin. (By the way, this is a new function as of 2015, version 10.2. It’s only about three years old, but it’s exactly what I need.)

Below I’m using the original code to generate all words containing a “q” and changed MemberQ to ContainsAll and changed “q” to the list of vowels.

qlist={};
Map[If[ContainsAll[#,{"a","e","i","o","u"}],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[StringJoin,qlist]

Wow! There are so many more words that contain all 5 vowels than I expected. I do see “sequoia” in the list. Is it the shortest? How long is each word?

Map[Length,qlist]

Now, find the minimum of that list.

Min[Map[Length,qlist]]

That has to be “sequoia.” Wait! Is that the only one? Hmmm. . . I don’t want to look through that whole list for another 7, so let’s sort it.

Sort[Map[Length,qlist]]

Yes, “sequoia” is the only one. My friend was right!

What if we include “y” in our list of vowels? There will be a new answer.

qlist={};
Map[If[ContainsAll[#,{"a","e","i","o","u","y"}],qlist=Append[qlist,#],qlist=qlist]&,Characters[WordList[]]];
Map[StringJoin,qlist]

Sort[Map[Length,qlist]]

There are actually 5 shortest words now. Can we easily find them?

Sort[Thread[Map[Length,qlist]->Map[StringJoin,qlist]]]

That wasn’t so hard was it? Or am I speaking facetiously?

Generating Actual Words Randomly

After we determined that WordList was insufficient for Scrabble, we went back to the original question.

“How likely would it be to generate an actual word in a list of 100 ‘words’ consisting of 5 random letters?”

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

How can we test for actual words?

DictionaryWordQ["pivot"]

DictionaryWordQ["pivet"]

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

After doing this a few times and coming up with only False, let’s increase the number of words.

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

Rather than looking through all of that for True, let’s count the True elements.

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

Only a few are found each time. Can we see what those words are? The code below is a modified version of the code for listing words containing the letter “q.” This will count actual words and list them.

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

What if we look for 3-letter words? (I skipped 4 on purpose.)

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

Or 2-letter words?

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

Wait! Something doesn’t seem right here. How many 2-letter combinations are there?

26^2

This is less than the number we found. Oh! The possibilities are even less than that. We are using RandomSample. RandomSample will not have repeated elements when doing the random selection.

26*25

With over 2000 words, what is going on? It’s generating duplicate random words. In the original 5-letter example, this would be quite unlikely, but still possible. Let’s add Union to the code. Now anything repeated is only listed once.

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

Each time we run this we get 152. That seems to indicate that there are 152 two-letter words in WordList. Wait! Those are only 2-letter words with no repeated letters.

Switch RandomSample to RandomChoice.

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

Is “xx” really a word? I don’t think that would work in Scrabble either. (It doesn’t. I checked scrabble.hasbro.com.)

I’m curious to look at the 5-letter words again with RandomChoice.

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

Interesting. Immediately we have words with repeated letters (though not always).

Note: We never actually answered the original question. One could run experiments to get an idea of the probabilities of generating actual words from random letters, but our conversation turned along a different path.

What about 1-letter words?

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

Apparently DictionaryWordQ considers every letter to be its own word.

See the Addendum below about another way to approach some of this.

An Alphabet of Words

The 1-letter word idea reminded me of a thought exercise I find myself doing from time to time.

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

Of course I think of “see” and “sea” and “eye.” I think of how when I visited Australia as a child, I thought it was funny that people stood in a “queue” rather than in a line. Now it occurs to me to use the Wolfram Language to answer my question and I shared this puzzle with the students.

I knew there was WordData and I figured there would be a way to get pronunciation.

WordData["Properties"]

Let’s try “PhoneticForm.”

WordData["see","PhoneticForm"]

WordData["c","PhoneticForm"]

It’s a match! What does the alphabet look like?

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

We spent a little time just looking at this result. Students immediately asked questions such as “Is that ‘w’?” and “Why is there an integral in ‘h’?”

I organized it a little differently to make it more useful.

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

Aside: In my classroom it appeared that it would take too long to find the PhoneticForm of each word in WordList, so I created a short, alternate word list to work with as we built the code. This worked well, but later when I revisited this at home, the whole WordList was reasonable to work with. Hopefully it will work okay at school too. Internet-based information sometimes causes hiccups in production.

wl={"house","sea","car","jay","oh"};
plist=Map[{#,WordData[#,"PhoneticForm"]}&,wl]

Now, let’s get the whole WordList in PhoneticForm, but listed as pairs with the actual word, like we did the alphabet. (This calculation may take some time.)

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

We looked again at WordData[“Properties”] to see if there was some way to go back from PhoneticForm. However, nothing seemed to fit, so we continued along.

I needed to do a little explanation of how Part (and the Part shortcut) works.

{"o","ˈoʊ"}[[2]]

phoneticlist[[31415]]

phoneticlist[[31415,2]]

Generally, we use the same list building algorithm that we used earlier for q-words and for vowel-words. Let’s try getting this to work for one letter. We know that “c” has two answers.

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

To get our whole answer, Table this across the whole alphabet. Replace {“c”,”sˈi”} with the phonetic alphabet list (where n represents each letter number). Each letter is checked against the entire WordList for matches with PhoneticForm. Results are gathered into one large list.

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

Pairing these values with the original alphabet allows us to display our result a little more clearly.

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

How fun!

Interesting that “a” was matched with itself, but not “I.”

Eye hope ewe had fun 2 . . . Owe! Should we do numbers next?

IntegerName[Range[0,9]]

Credits

EIWL: Stephen Wolfram, Elementary Introduction to the Wolfram Language, 2nd Edition, 2017.

JMM: Joint Mathematics Meetings 2018, San Diego, CA. Estimathon! organized by Andy Niedermaier, Jane Street Capital. Teams were challenged to solve Fermi problems.

Scrabble (Probably SCRABBLE©): See scrabble.hasbro.com. In particular “Scrabble Word Lists” under Tools >> Scrabble Resources.

Additional Note

While reading through the A.I. Adventure “Can You Break Julius Caesar’s Cryptosystem?” published by the Computational Thinking Initiative in preparation for tomorrow’s CT@TP meeting, I saw the following information in the introduction.

Computational Thinking Principles and Practices

Exploring entire categories all at once (i.e. look at all flags, all of Shakespeare’s sonnets, etc.)

Simulating things that are hard or impossible to do by performing real-world experiments

Treating the computer’s “misunderstandings” as proxies for one’s own

I believe this “Alpha Words” conversation naturally met all of these points. We explored WordList as an entire category of words. We simulated creating random words and searching through the entire list of words looking for combinations of characters. This would be nearly impossible without a computer. And certainly we found cases where the computer seemed to give us the wrong answer: an unexpected answer that made us reconsider our approach to solving the problem and revealed our own misunderstanding.

P.S. Numbers

I did try the numbers and it worked really well adapting the code. Yet, I noticed that “eight” did not match with “ate” even though they have the same phonetic form.

WordData["eight","PhoneticForm"]

WordData["ate","PhoneticForm"]

WordData["eight","PhoneticForm"]==WordData["ate","PhoneticForm"]

With a little digging, I found that “ate” is not in the WordList. That the list excludes unusual q-words isn’t too much of a surprise, but I expected to see “ate.”

Take[WordList[],{2120,2140}]

MemberQ[WordList[],"ate"]

Update: IncludeInflections

While working on another project, I learned that WordList has an option called IncludeInflections. This will have the list include various verb forms.

Length[WordList[]]

Length[WordList[IncludeInflections->True]]

MemberQ[WordList[IncludeInflections->True],"ate"]

The code below will take some time to evaluate because it finds the phonetic form of the longer WordList.

phoneticlist=Map[{#,WordData[#,"PhoneticForm"]}&,WordList[IncludeInflections->True]];
numberphon=Map[{#,WordData[#,"PhoneticForm"]}&,IntegerName[Range[0,9]]];
numberanswer=Table[
numberlist={};
Map[If[numberphon[[n]][[2]]===#[[2]],numberlist=Append[numberlist,#],numberlist=numberlist]&,phoneticlist];
numberlist,{n,1,10}];
Grid@Partition[Riffle[IntegerName[Range[0,9]],numberanswer],2]

Addendum

Two weeks later, as I am continuing to read EIWL, Chapter 30 “Rearranging Lists” reminded me of some things that I wished I had thought of in the midst of the conversation above.

In particular, Exercise +30.13 says “Generate 1000 random sequences of 4 letters, and make a list of ones that appear in WordList[].” My answer uses Intersection.

Intersection[Table[StringJoin[RandomChoice[Alphabet[],4]],1000],WordList[]]

The output generated earlier for 10,000 randomly generated 5-letter words could be done like this.

Reverse[{wrds=
Intersection[Table[StringJoin[RandomChoice[Alphabet[],5]],10000],WordList[]],
Length[wrds]}]

Update: StringContainsQ

While working on something else, I came across StringContainsQ and realized that all of this . . .

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

. . . could be done with just this . . .

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

. . . and they are the same.

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

This is by no means the first time I’ve worked through coding something in the Wolfram Language only to find out later there is a function that does exactly what I needed.

Also, we can use this to find all of the words that contain “q” but do not contain “e.” Note that the operator form of StringContainsQ does not work with Not so we need to organize it a little differently.

Select[Select[WordList[],StringContainsQ["q"]],Not[StringContainsQ[#,"e"]]&]

Much simpler and more direct. What about the words with all vowels?

Select[WordList[],(ContainsAll[Characters[#],{"a","e","i","o","u"}])&]

Really the key here is using Select. With my list generated further above by checking each word, Select is pretty much what I was doing.

The notebook above is really about capturing what we did in the moment as we approached different questions. I’m now thinking to rewrite parts of this into different activities for the computational thinking club. Stay tuned.

Update: One-Liner Competition 2018

In October 2018, I attended the annual Wolfram Technology Conference in Champaign, Illinois. Each year as part of the conference, attendees are invited to participate in the annual One-Liner Competition by submitting “the most stupendous, entertaining, amazing, surprising, astounding effects you can achieve in 128 characters or fewer of tweetable Wolfram Language code.”

I used this Alpha Words computational thinking conversation as inspiration and was able to condense finding an alphabet of words into exactly 128 characters, even with a little formatting. For a while I was stuck on 129 characters, but changing the organization of a word with its phonetic form from a list to a rule made the difference.

I’m proud to share that “Alphabet of Words” won Third Prize in the competition!

w=#->WordData[#,"PhoneticForm"]&;a=w/@Alphabet[];p=w/@WordList[];Grid@Table[{a[[n]],If[a[[n,2]]===#[[2]],#,Nothing]&/@p},{n,26}]

To see more from the 2018 One-Liner Competition, read the article by Chris Carlson linked below.
http://blog.wolfram.com/2018/10/25/the-winners-of-the-2018-one-liner-competition

Abby Brown
www.abbymath.com
CT@TP: Computational Thinking at Torrey Pines High School
January 2018 (Updated November 2018)