NYT Spelling Bee puzzle

Question

I've written some code that provides answers to the daily NYT Spelling Bee puzzles which ask you to find words that can be constructed from 7 given letters, one of which must be present in each word:

allLetters = {"o", "p", "h", "e", "y", "n", "t"};
centerLetter = "t";
testWordChars = Table[Characters[WordList[][[n]]], {n, 1, Length[WordList[]]}];
compWords = Table[Complement[testWordChars[[n]],allLetters], {n,1,Length[WordList[]]}];
testWords = Table[If[compWords[[n]] == {}, True, False], {n, 1, Length[WordList[]]}];
pos = Flatten[Position[testWords, True]];
prelim = Flatten[Table[WordList[][[pos]], {n, 1}]];
centerTest = Table[StringContainsQ[prelim[[n]],centerLetter], {n, 1,Length[prelim]}];
pos2 = Flatten[Position[centerTest, True]];
final = Flatten[Table[prelim[[pos2]], {n, 1}], 1];
DeleteCases[final, _?(StringLength[#] < 4 &)]

This gives: {"entente", "eyetooth", "honeypot", "hoot", "hotpot","neophyte","nett", "note", "onto", "opponent", "pent", "petty", "peyote", "phenotype", "photo", "photon", "poet", "pontoon", "poppet", "potent", "potty", "python", "teen", "teeny", "teeth", "teethe", "tenet", "tenon", "tent", "tenth", "tepee", "thee", "then", "they","tone", "tonne", "toot", "tooth", "toothy", "topee", "tote", "type","typhoon", "typo"}

This takes about 10 minutes to execute, and I'm interested in learning about an approach that is significantly faster. Thanks!

Answer 1

Something like this perhaps?

allLetters = {"o", "p", "h", "e", "y", "n", "t"};
centerLetter = "t";

(*load in word list*)
wl = WordList[];

(*select the words that contain centerLetter*)
wl = Select[wl, StringContainsQ[#, centerLetter] &];

(*now select the words that only consist of allLetters*)
Select[wl, Complement[Characters[#], allLetters] == {} &]

{entente,eyetooth,honeypot,hoot,hot,hotpot,neophyte,net,nett,not,note,nth,onto,opponent,opt,pent,pet,petty,peyote,phenotype,photo,photon,poet,pontoon,poppet,pot,potent,potty,python,tee,teen,teeny,teeth,teethe,ten,tenet,tenon,tent,tenth,tepee,the,thee,then,they,tho,thy,to,toe,ton,tone,tonne,too,toot,tooth,toothy,top,topee,tot,tote,toy,type,typhoon,typo,yet}

This takes ~1-2 s in a fresh kernel, but is kind of misleading because most of the time is spent initializing the WordList. If we just look at the method itself

AbsoluteTiming[
  (*select the words that contain centerLetter*)
  wl = Select[wl, StringContainsQ[#, centerLetter] &];
  (*now select the words that only consist of allLetters*)
  Select[wl, Complement[Characters[#], allLetters] == {} &];
  ][[1]]

0.053939

It takes about 0.05 s. FWIW, you can also remove centerLetter from allLetters after Select[wl, StringContainsQ[#, centerLetter] &], but I thought this only makes the code a little faster at the cost of less readability.

Answer 2

The OP's statement of the Spelling Bee problem is incorrect. Solution words must be longer than 4 characters. The OP's "solution" violates this constraint.

Select[DictionaryLookup[___ ~~ "g" ~~ ___], 
(ContainsOnly[Characters[#], Characters["elmnoug"]] && StringLength[#] > 4) &]

Usually takes less than 0.1 seconds.

Answer 3

A point-free variation in post-fix notation:

wl = DictionaryLookup[];

wl //
   Select[StringContainsQ[{"t"}]] //
  Select[GreaterEqualThan[4]@*StringLength] // 
 Select[ContainsOnly[{"o", "p", "h", "e", "y", "n", "t"}]@*Characters]

---

{"entente", "eyeteeth", "eyetooth", "honeypot", "hoot", "hotpot",
"neophyte", "nepenthe", "nett", "note", "onto", "opponent", "pent",
"petty", "peyote", "phenotype", "photo", "photon", "poet", "pontoon", \ "poppet", "potent", "potty", "python", "teen", "teeny", "teeth",
"teethe", "tenet", "tenon", "tent", "tenth", "tepee", "thee", "then", \ "they", "tone", "tonne", "tony", "toot", "tooth", "toothy", "topee", \ "tote", "type", "typhoon", "typo"}

---

You can replace the first clause with:

Select[ContainsAny[{"t"}]@*Characters]; albeit doing so at this stage would slow it down somewhat. Thankfully, there are only a finite number of words in the dictionary.