Group Abstract Group Abstract

Message Boards Message Boards

Wolfram Language for Motivational Words

Rodrigo Murta, Looqbox
Posted 10 years ago

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

enter image description here

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"]

enter image description here
POSTED BY: Rodrigo Murta
8 Replies
Sort By:

enter image description here - 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!
POSTED BY: EDITORIAL BOARD
Amalie Jenner
Amalie Jenner
Posted 10 years ago

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

WordCloud[
 Select[WordList[], Total[LetterNumber[Characters[#]]] == 100 &], 
 WordSpacings -> "3", WordOrientation -> "Random"]
POSTED BY: Amalie Jenner

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.
POSTED BY: Sander Huisman

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

LetterNumber["?", "Greek"]
(* 11 *)
POSTED BY: Vitaliy Kaurov

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]

enter image description here

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]

enter image description here

Now let's make our little indexed database:

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

enter image description here

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." ;-)

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

enter image description here

enter image description here
POSTED BY: Vitaliy Kaurov
Mike Spring
Mike Spring
Posted 10 years ago

That's very cool Vitaliy, how did you make that graph by the way?
POSTED BY: Mike Spring

Good Job!!! :-)

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]

enter image description here
POSTED BY: Daniel Carvalho

Hi @Daniel Interesting this Google API for search. Tks for sharing!
POSTED BY: Rodrigo Murta
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard