Wolfram Language for Motivational Words

Staff Picks
, , , ,
1

When I saw this picture on Linkedin I thought: “What are the other 100 points words?”

8461ext.jpg
8461ext.jpg800×600 114 KB

Well, pretty easy with WL, using just 3 lines of code. First let’s create our wordValue function:

index = First/@PositionIndex@CharacterRange["a","z"];
wordValue[word_String]:= Total[Lookup[index, #, 0]&/@StringPartition[ToLowerCase@RemoveDiacritics@word,1]]

Testing the code we have:

wordValue/@{"knowledge", "hardwork", "attitude"}
{96, 98, 100}

Great, the check is ok! Now what are the other words? One more line:

words100 = Select[DictionaryLookup[], wordValue[#]==100&]

Now, take care with “useless and inefficient elephants” in your company, these are 100 points words!

wordValue/@{"useless", "inefficient", "elephants"}
{100, 100, 100}

Here is a Word Cloud with a sample of 100 words from the total of 1054:

WordCloud[RandomSample[words100, 100], WordOrientation -> "Random"]

Screen-Shot-2015-12-03-at-10.06.41-AM.png
Screen-Shot-2015-12-03-at-10.06.41-AM.png1082×838 181 KB

17 Likes
2

Good Job!!! :slight_smile:

I am wondering how the word cloud would looks like if we set the words size according Google search statistics.

In order to get that I did a simple function:

estimatedResultCount[word_] :=
 ToExpression[
  Import[StringJoin[
     "https://www.googleapis.com/customsearch/v1?key=\
<Google KEY>&cx=<Google CX>&q=", word], "JSON"][[3, 2, 1, 2, 1, 1, 2]]]

We pass a word to the function, and it search at google and get a JSON message back, we go deep at the JSON message and get the number we are interested in.

It is important to notes that to get the Google KEY and CX you should register as a google developer, check this out:

Google Developer Console

There are some limits of requests by day and requests by second (time) at Google.

The result is:

sample = RandomSample[words100, 10];
WordCloud[#] &[{#, estimatedResultCount[#]} & /@ sample]

wc.png
wc.png255×138 4.17 KB

9 Likes
3

Absolutely marvelous! But could there be another way? I think many. Here is one.

Don’t you think ranking letters according the order they appear in the alphabet is sort of random? I suggest we rank them according to their frequency in the full dictionary.

letterRANK = MapIndexed[Prepend[#1, First[#2]] &, 
   Sort[Tally[Select[Flatten[Characters[ToLowerCase[WordData[]]]], LetterQ]], #1[[2]] > #2[[2]] &]];

As you can see (first number) I ranked (gave most points) the highest the rarest letters. I consider them jems because I guess they make up the rarest (I hope the funniest?) words.

Multicolumn[letterRANK, 2]

2015-12-03_13-49-15.png
2015-12-03_13-49-15.png232×227 39.5 KB

And I must say the frequencies do give a weird graph:

ListLinePlot[letterRANK[[All, 3]], PlotTheme -> "Business", Filling -> Bottom, 
 FrameTicks -> { {Automatic, None}, {letterRANK[[All, {1, 2}]], None}}, GridLines -> All]

sdftyjruiyt23456.png
sdftyjruiyt23456.png544×329 11.1 KB

Now let’s make our little indexed database:

indexRANKED = Association[Thread[letterRANK[[All, 2]] -> letterRANK[[All, 1]]]]

2015-12-03_13-51-06.png

Here is Rodrigo’s function:

wordValue[word_String] := 
 Total[Lookup[indexRANKED, #, 0] & /@ StringPartition[ToLowerCase@RemoveDiacritics@word, 1]]

and here it is - our new jem-like 100-points scoring words:

words100 = Select[DictionaryLookup[], wordValue[#] == 100 &];

But let’s go a step further. Consider the most POPular words those who get 100 points the quickest — with least amount of letters. And consider the most RARE words those who get 100 points the slowest — with most amount of letters. We weigh them according to this logic for word cloud:

weightPOP = {#, 1/StringLength[#]} & /@ Union[ToLowerCase[words100]];
weightRARE = {#, StringLength[#]} & /@ Union[ToLowerCase[words100]];

And now behold their corresponding word clouds - I bet you will grab the dictionary. A recent quote from a friend looking at this “I’m thrilled to my very kutuzov.” :wink:

WordCloud[weightPOP]
WordCloud[weightRARE, ScalingFunctions -> (#^2 &)]

sdfaertw456hrgsfdadv.png
sdfaertw456hrgsfdadv.png955×935 204 KB

asdf546gjhfdsd57648thg.png
asdf546gjhfdsd57648thg.png918×905 207 KB

9 Likes
4

Hi @Daniel Interesting this Google API for search. Tks for sharing!

5

By the way, @Rodrigo Murta, the new function LetterNumber would make things easier:

LetterNumber["?", "Greek"]
(* 11 *)
1 Like
6

Very nice results! Cool stuff!
Your wordvalue is fast, but looks very convoluted!

I came up with two ways:

rules = Dispatch[# -> LetterNumber[#] & /@ Alphabet[]]
wordvalue2[word_String] := Total[Characters[ToLowerCase@RemoveDiacritics@word] /. rules]
wordvalue3[word_String] := Plus @@ LetterNumber@ToLowerCase@RemoveDiacritics@word

Note that I do Plus@@ rather than Total@ in order to deal with 1 letter words…

In your version you could replace StringPartition[...,1] by Characters.

2 Likes
7

I found this could be easily achieved in one line of code

WordCloud[
 Select[WordList[], Total[LetterNumber[Characters[#]]] == 100 &], 
 WordSpacings -> "3", WordOrientation -> "Random"]
3 Likes
8

That’s very cool Vitaliy, how did you make that graph by the way?

9

2015-11-02_10-07-11.png

  • another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the tops of the “Featured Contributor” board. Thank you for your wonderful contributions, and please keep them coming!

1 Like