6
$\begingroup$

I am trying to find all English words composed of specified characters. For example, all words composed of one or more of the following: {"A", "C", "D", "H", "I", "R", "N"}, where all the letters except "N" can appear 0 or more times, and "N" must appear at least once.

I have been handling this by brute force, creating all Tuples of the letters, screening for those that contain "N", then running a DictionaryLookup[] over the whole list. For example, for words of length seven:

letterList={"A", "C", "D", "H", "I", "R", "N"};
requiredLetter="N";
wordLength=7;

candidates = 
  Map[ToLowerCase[StringJoin[#]] &, 
   Select[Tuples[letterList, wordLength], MemberQ[#, requiredLetter] &]];
evals = Map[{#, DictionaryLookup[#, "IgnoreCase" -> False]} &, candidates];
winners = Select[evals, Length[#[[2]]] > 0 &];

The qualifying words of length 7 in this case are "candida" and "handcar".

Among the problems with this approach, the list of tuples is of length Length[letterList]^ wordLength, which quickly gets into the billions and crashes the kernel for wordLengths longer than 10.

I invite suggestions for more efficient approaches that would allow me to check for words of longer length. It feels as though regular expression searches of the dictionary may work but it's not an area I have any skill with.

$\endgroup$
6
$\begingroup$

I might be wrong, but I believe the answer is simple when you look at it from a different view. Let's say we want to create a function, that gives us False if your conditions are not met. So your word must contain at least one "N", if not then it's definitely out:

isGood[str_String /; StringFreeQ[str, "N", IgnoreCase -> True]] := False;

And then you say, it can only consist of the other letters. So what will happen, if we replace in a word all your good letters by "". A word you are interested in will afterward contain nothing at all, right? Let's write this down:

isGood[str_String] := 
 StringReplace[
   str, {"A" -> "", "C" -> "", "D" -> "", "H" -> "", "I" -> "", 
    "R" -> "", "N" -> ""}, IgnoreCase -> True] === "" 

Ready to rock I guess:

words = DictionaryLookup["*"];
Select[words, isGood]

(*
{"Adan", "Adana", "Adrian", "Adriana", "an", "Ana", "Anacin", \
"anarchic", "and", "Ann", "Anna", "arachnid", "Arcadian", "arcana", \
"Cain", "cairn", "can", "Canaan", "Canada", "Canadian", "canard", \
"cancan", "candid", "candida", "Cardin", "Carina", "Chadian", \
"chain", "Chan", "Chandra", "Chicana", "chin", "china", "China", \
"cinch", "circadian", "cnidarian", "CNN", "Cranach", "Dan", "Dana", \
"Darin", "darn", "Darrin", "Diana", "Diann", "Dianna", "din", "Dina", \
"Dinah", "dinar", "DNA", "drain", "Hadrian", "Hahn", "Han", "hand", \
"handcar", "Hanna", "Hannah", "Hardin", "harridan", "hind", "Hindi", \
"Ian", "Icahn", "in", "Ina", "Inca", "inch", "India", "Indian", \
"Indiana", "Indianan", "Indianian", "Indira", "Indra", "inn", "Iran", \
"Iranian", "Nadia", "nadir", "nah", "naiad", "Nair", "nan", "Nan", \
"Nara", "narc", "Narnia", "NCAA", "niacin", "Nina", "radian", "rain", \
"ran", "ranch", "rancid", "rand", "Rand", "Randi", "rind"}
*)
$\endgroup$
6
$\begingroup$
patt = w : Alternatives["A", "C", "D", "H", "I", "R", "N"] .. /;
 StringCount[w, "N", IgnoreCase -> True] == 1;

DictionaryLookup[patt, IgnoreCase -> True]

(*
{"Adan", "Adana", "Adrian", "Adriana", "an", "Ana", "anarchic", \
"and", "arachnid", "Arcadian", "arcana", "Cain", "cairn", "can", \
"Canada", "canard", "candid", "candida", "Cardin", "Carina", \
"Chadian", "chain", "Chan", "Chandra", "Chicana", "chin", "china", \
"China", "cinch", "circadian", "Cranach", "Dan", "Dana", "Darin", \
"darn", "Darrin", "Diana", "din", "Dina", "Dinah", "dinar", "DNA", \
"drain", "Hadrian", "Hahn", "Han", "hand", "handcar", "Hardin", \
"harridan", "hind", "Hindi", "Ian", "Icahn", "in", "Ina", "Inca", \
"inch", "India", "Indira", "Indra", "Iran", "Nadia", "nadir", "nah", \
"naiad", "Nair", "Nara", "narc", "NCAA", "radian", "rain", "ran", \
"ranch", "rancid", "rand", "Rand", "Randi", "rind"}
*)

This can also be used with lists of words, using Pick[candidates, StringMatchQ[candidates, patt]].

After reading Mr.Wizard's answer I noticed I had missed or misread some requirements. This is my updated version:

letters = Alternatives["A", "C", "D", "H", "I", "R", "N"];
patt = w : (letters ... ~~ "N" ~~ letters ...) /; StringLength[w] == 7;
DictionaryLookup[patt, IgnoreCase -> True]

(*
{"Adriana", "candida", "Chadian", "Chandra", "Chicana", "Cranach", \
"Hadrian", "handcar", "Indiana", "Iranian"}
*)
$\endgroup$
  • 1
    $\begingroup$ (+1) you need to add "N" to letters to get words with multiple "N"s. $\endgroup$ – kglr Feb 25 '17 at 9:04
  • $\begingroup$ @kglr yes, thanks. $\endgroup$ – C. E. Feb 25 '17 at 9:09
  • $\begingroup$ Great answer. I solved the multiple-N problem by changing the StringCount test instead, but it's basically instantaneous either way. StackExchange lets me accept only one answer or else I'd have taken this one too. $\endgroup$ – Michael Stern Feb 25 '17 at 21:44
4
$\begingroup$

I independently arrived at code similar to Pickett's answer:

DictionaryLookup[
  x : Repeated["A"|"C"|"D"|"H"|"I"|"R"|"N", {7}] /; StringMatchQ[x, "*n*"],
  IgnoreCase -> True
]
{"Adriana", "candida", "Chadian", "Chandra", "Chicana", 
 "Cranach", "Hadrian", "handcar", "Indiana", "Iranian"}
$\endgroup$
  • $\begingroup$ Yes, much better solution than how I was doing it. Thanks. $\endgroup$ – Michael Stern Feb 25 '17 at 21:44

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.