# Finding all of the words containing certain letters

Is there a fast method to find all of the words containing the letters: {a, e, i, o, u, y}? I created an algorithm, but it takes more than 11 seconds to find all of the words:

FindWords[{x_, y_, z_, t_, v_, n_}] :=
DictionaryLookup[___ ~~ ToString[x] ~~ ___ ~~ ToString[y] ~~ ___ ~~
ToString[z] ~~ ___ ~~ ToString[t] ~~ ___ ~~ ToString[v] ~~ ___ ~~
ToString[n] ~~ ___];
Union[Flatten[
Map[FindWords, Permutations[{a, e, i, o, u, y}]]]]


Is there a faster way to do this?

• Welcome to Mathematica.SE! I suggest the following: 0) Browse the common pitfalls question 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! – Dr. belisarius Aug 23 '15 at 20:25
• Fun question - added an answer that's ~1000X faster on my loungebook. +1 – ciao Aug 24 '15 at 1:02
• The Mathematica dictionary misses many words. This answer on ELU (using Python and the US Scrabble dictionary) finds a lot more words that fit your requirement. Just those words starting with an a that are not listed by Mathematica (taken from the answer on ELU, compared with the query in the accepted answer here): *actinomycetous, aeronautically, aneuploidy, antiregulatory, audiometry, autoeciously, autotetraploidy, autotypies. For practical applications, I suggest using your own dictionary (in Mathematica). – JJJ Jul 8 '18 at 15:06

I think you'll find this considerably faster...

Intersection @@ (DictionaryLookup["*" <> # <> "*"] & /@Characters["aeiouy"])


and getting sneaky with letter probabilities, about five times as fast as above:

Fold[Pick[#, StringFreeQ[#, #2], False] &,
DictionaryLookup["*" <> First@Characters["yuioae"] <> "*"],
Rest@Characters["yuioae"]]


Here's a function that wraps this all up, takes care automatically of optimizing the trimming by letter probabilities:

findHasAllLetters[letters_] :=
Module[{c = Characters@letters, lf = "etaoinsrhldcumfpgwybvkxjqz"},
c = c[[Reverse@Ordering@(StringPosition[lf, #][[1, 1]] & /@ c)]];
Fold[Pick[#, StringFreeQ[#, #2], False] &, DictionaryLookup["*" <> First@c <> "*"], Rest@c]];


Timings (n.b., this is on an old loungbook, so probably 10X faster or so on a real machine):

findHasAllLetters["aeiouy"] // Timing


Timing your OP example on the loungbook, that was over 1000X faster. Modifying your code to add one more letter, so searching on e.g. {a, e, i, o, u, y, m}, this was well over 5000X faster... on a search for something like letters "etaoinsrhld", s/b over 50,000,000X faster.

If that's still not fast enough, it can be sped up another order of magnitude+, at the cost of more complex code. Let me know...

Update: Here's the faster method alluded to:

findHasAllLettersBMBuild[words_] :=
Module[{cc, mcc, ccm, mcx, ccmb, lccm, fn},
mcc = Min[cc = DeleteDuplicates /@ ToCharacterCode[words]];
lccm = Length[ccm = Subtract[cc, mcc]];
mcx = Max@ccm;
ccmb =
FromDigits[#, 2] & /@ (Reverse@
Transpose[SparseArray[IntegerDigits[Tr /@ (2^ccm), 2, mcx + 1], {Length@ccm, mcx + 1}]]);
fn =
Pick[words,
IntegerDigits[BitAnd @@ ccmb[[Subtract[ToCharacterCode[#], mcc] + 1]], 2, lccm], 1] &; fn];


Use:

You "load it" with the words/dictionary of choice (need to do this just once per session of use, or to change dictionary/word list - here we'll just use the complete MMA dictionary):

myfn = findHasAllLettersBMBuild[DictionaryLookup[]];


Then, to do any searches:

myfn["aeiouy"] // Short // Timing


So, below timer threshold on a squirrel-powered netbook...

A quick relative lookup performance comparison (fastest is normalized to 1, so scale shows multiple of time of fastest. Tested only on the "aeiouy" case. OP code will be dramatically slower for more letters, rest should remain relatively stable. N.b. - the fastest was consistently below timer resolution, so to get something to compare, I used a dictionary of five copies for it, the rest use just the one copy of DictionaryLookup):

• Nice! :) $\phantom{}$ – rm -rf Aug 23 '15 at 23:54

DictionaryLookup for each case, combined with string patterns involving ___ can be very slow. It would be faster to do it in one pass over all the words in the dictionary:

With[{words = DictionaryLookup[], letters = Characters["aeiouy"]},
Select[words, Intersection[Characters[#], letters] == letters &]]


This takes ~0.35 seconds on my laptop, compared to ~20 seconds for the original.

• +1, can be improved > order of magnitude... – ciao Aug 23 '15 at 23:52

 Cases[DictionaryLookup["*"],

• This doesn't do what the OP requested in the question. Their output contains words with all of the letters in a, e, i, o, u, y whereas this returns words with any of the letters in that list. – rm -rf Aug 23 '15 at 20:12