17
$\begingroup$

Suppose that we are just typing random letters with our keyboards and we include space bar. We don't distinguish between capital and lowercase letters. If we do this for a long time, how many of the words will be real words? How should one do this in Mathematica?

$\endgroup$
9
  • 5
    $\begingroup$ It depends on who types. Monkeys anyone? $\endgroup$ Nov 18, 2015 at 15:35
  • $\begingroup$ Do humans have a preference for certain letters on the keyboard, in the same way that people think they can choose numbers at random? $\endgroup$ Nov 18, 2015 at 15:48
  • 4
    $\begingroup$ n = 100000; chars = Union[{" "}, CharacterRange["a", "z"]]; p = DictionaryLookup /@ StringSplit@StringJoin@RandomChoice[chars, n]; (Length@p - Count[p, {}])/Length@p // N $\endgroup$ Nov 18, 2015 at 15:53
  • 2
    $\begingroup$ I do not think that ´DictionaryLookup" helps here. E.g. for the "German" language the dictionary contains few more than 76000 words. This is by far to few. To cover the "most" words in the German language one would need more than 10 times as much words. $\endgroup$
    – mgamer
    Nov 18, 2015 at 17:54
  • 1
    $\begingroup$ Another factor is how you determine how much each key is pressed. Is each letter and the space bar equally randomly pressed? Is the space bar pressed 5 times as often since it is 5 times the size? $\endgroup$
    – Kevin
    Nov 18, 2015 at 20:49

4 Answers 4

21
$\begingroup$

Just for comparing with Pillsy's answer, let's suppose we generate a uniformly random sequence of a-z and spacebar.

SeedRandom[42];
n = 10^7;
chars = Union[{" "}, CharacterRange["a", "z"]]; 
p = DictionaryLookup /@ StringSplit@ StringJoin@ RandomChoice[chars, n]; 

(Length@p - Count[p, {}])/ Length@p // N

(* 0.0071783 *)

2558out of 356352 are "dictionary words"

And these are the relevant lengths distribution taking or discarding duplicates:

Sort@Tally@StringLength@Flatten@p
Sort@Tally@StringLength@Flatten@Union@p

(* {{1, 496}, {2, 1475}, {3, 495}, {4, 83}, {5, 8}, {6, 1}}
   {{1, 1},   {2, 77},   {3, 351}, {4, 82}, {5, 8}, {6, 1}}*)

Select[Flatten@Union@p, StringLength@# > 4 &]
(* {"apnea", "carny", "crony", "hopped", "jacks", "mound", "rhino", "shots", "swags"}*)
$\endgroup$
1
  • $\begingroup$ And what is the theoretical mean that you should get given your model (and how would you figure it out with Mathematica)? $\endgroup$ Nov 20, 2015 at 9:32
18
$\begingroup$

the probability of a sequence of a given length being a word (as reported by DictionaryLookup):

 p[n_] := p[n] = (ToLowerCase /@ 
        DictionaryLookup[StringExpression @@ ConstantArray[_, n]] // 
             Union // Length)/26^n // N    (* 27^n if spaces are to be included *)
 Show[{
   ListLogPlot[Table[{n, p[n]}, {n, 3, 20}]],
   LogPlot[ 71625 Exp[-3.6 x  ], {x, 5, 20}]}]

enter image description here

numc = 100000;
list = RandomChoice[CharacterRange["a", "z"], numc];
(* for spaces:
list = RandomChoice[Append[CharacterRange["a", "z"], " "], numc]; *)
TableForm[
 res = Table[ {n, 
    Flatten[DictionaryLookup[StringJoin[#],IgnoreCase -> True] & /@ 
       Partition[ list , n, 1]] // Length , numc p[n]} , {n, 3, 20}], 
 TableHeadings -> {None,{"Len", "count", "expected"}}]
Print["total words found: ", res[[All, 2]] // Total, " expected: " , 
  numc Sum[p[n], {n, 3, 20}] ];

enter image description here

total words found: 5565 expected: 5632.06

Edit re: .. the prediction in consistently high by almost exactly 3/2.. This was because DictionaryLookup is case sensitive. IgnoreCase -> True fixes it.

I suppose this may be useful to tabulate:

 TableForm[ Table[ {k, Sum[p[n], {n, k, 25}]}, {k, 2, 7}] ,
    TableHeadings -> {None, {"min word", "expected words/length"}}]

enter image description here

including spaces (equal proability as a letter) doesn't affect things much..

enter image description here

and just for fun.. (note DictionaryLookup is pretty liberal with what it considers words )

numc = 1000;
n = 4
list = RandomChoice[CharacterRange["a", "z"], numc]; words = 
 IntervalUnion @@ 
  Reap[MapIndexed[ 
     If[Length@DictionaryLookup[StringJoin[#], IgnoreCase -> True] == 
        1, Sow[Interval@(Flatten@{#2, #2 + n - 1})]] &, 
     Partition[list, n, 1] ]][[2, 1]];
Row /@ Partition[
   MapIndexed[ 
    If[ IntervalMemberQ[words, First@#2] , Style[ #, Red], #] &  , 
    list], 80] // TableForm

enter image description here

$\endgroup$
14
$\begingroup$

Let's assume we're generating letters with the same frequency as they appear in the dictionary, in strings with lengths that have the same frequency as the lengths of words in the dictionary. To do this, first we need a list of words:

words = DictionaryLookup[];
letters = (Values@# -> Keys@#) &@CharacterCounts[StringJoin[words]];
lengths = (Values@# -> Keys@#) &@Counts[StringLength[words]];

Now we need a fast way of testing if something is a word, which we can do using Dispatch (which in my testing is about 30 times faster than just using DictionaryLookup):

Attributes[wordQ] = Listable;
With[{table = Dispatch[Append[Thread[words -> True], _ -> False]]},
  wordQ[s_String] := Replace[s, table]];

Then we can see how many words we get if we let our monkeys bang away for a million tries:

BlockRandom[
  SeedRandom[137];
  trials = 
   Counts[
    wordQ[Table[StringJoin[RandomChoice[letters, RandomChoice[lengths]]],  
      1000000]]]] // AbsoluteTiming
(* {4.31088, <|False -> 997584, True -> 2416|>} *)

UnitConvert[N[True/(True + False) /. trials], "Percent"]
(* 0.2416% *)

So it looks like the answer is about 2.4 in a thousand, using this particular distribution of strings.

$\endgroup$
2
  • $\begingroup$ I have this error, what am I doing wrong? prntscr.com/9470xq $\endgroup$
    – Atvin
    Nov 18, 2015 at 16:41
  • $\begingroup$ @Atvin totally my fault; I copied the wrong thing over. It's fixed now. The problem before was I was using freqs instead of letters and never copied over the definition for letters. $\endgroup$
    – Pillsy
    Nov 18, 2015 at 16:49
12
$\begingroup$

Of course the answer depends greatly on how you "randomly" choose the letters. Here is a Manipulate that reads in a source text, which is used to define the probability of occurrence of any given letter. It writes a short "poem" based on those probabilities. You can also look at probability "pairs" (how often a is followed by b, how often a is followed by c, etc) or at probability triples (how often ab is followed by a, for instance.) As you increase the length of the correlation, more and more actual words appear.

imageNames = 
  ExampleData["Text"][[Flatten[{Range[15], Range[17, 26], 28}]]];
pRange[start_, end_, inc_] := Table[{i}, {i, start, end, inc}];
lenPiece = 850; againOld = False; bookOld = {};
Manipulate[
 If[again != againOld || bookTitle != bookOld, 
  rawString = ExampleData[bookTitle]; againOld = False; again = False;
   bookOld = bookTitle;]; 
 textProc = StringJoin[
   Riffle[ToLowerCase[StringCases[rawString, LetterCharacter ..]], " ", 2]];
 startPos = First[RandomChoice[Drop[StringPosition[
       StringTake[textProc, Round[StringLength[textProc]/2]], " "], 
      3]]] - 1; 
 poem = StringSplit[StringTake[StringJoin[NestList[
      StringJoin[StringTake[#, -(mTerms - 1)], 
        RandomChoice[StringCases[textProc, # ~~ xx_ -> xx]]] &, 
      StringTake[textProc, {startPos, startPos + mTerms - 1}], 
      lenPiece]], mTerms {1, lenPiece, 1}]];
 formatPoem = StringJoin[
   Insert[Insert[poem, "\n", pRange[8, Length[poem], 8]], " ", 
    pRange[1, 1.1 Length[poem], 1]]];
 numLines = StringPosition[formatPoem, "\n"];
 outPoem = StringTake[formatPoem, First[numLines[[Min[Length[numLines], 20]]]]];
 titleLong = 
  StringJoin[Insert[Take[poem, 4], " ", pRange[1, 4, 1]]] ~~ "\n";
 title = StringTake[titleLong, Min[StringLength[titleLong], 30]];
 Graphics[{Text[
    Style[title, Bold, FontSize -> 16], {0, 1}], {Text[
     Style[outPoem, FontSize -> 12, LineSpacing -> {1.1, 0}], {0, 
      0}]}}, ImageSize -> {400, 400}],
 {{bookTitle, {"Text", "AliceInWonderland"}, "Source Text"}, 
  Thread[imageNames -> imageNames[[All, 2]]]},
 Row[{Control[{{again, False, "New Poem"}, {False, True}}],
   Control[{{mTerms, 3, "      # of Succesive Letters"}, Range[5]}]}]]

Here it is, run with Alice in Wonderland as the source text and a correlation length of 1:

enter image description here

and now with a correlation length of 3

enter image description here

$\endgroup$
3
  • $\begingroup$ +1, but Lewis Carroll did the same thing a long time ago $\endgroup$ Nov 18, 2015 at 20:57
  • 3
    $\begingroup$ @belisarius -- but did he do it with Mathematica? If not, he would have been closed as off-topic. $\endgroup$
    – bill s
    Nov 18, 2015 at 23:01
  • $\begingroup$ :D As an aside, he tried to get the printer to print it mirrored, but the technical and budgeting difficulties later dissuaded him. He didn't have Rasterize[ ]! :) $\endgroup$ Nov 18, 2015 at 23:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.