# Finding all dictionary words that can be made with a given set of characters (Wordfeud/Scrabble)

This is a slightly more involved variant of this recent question. By sheer coincidence I happened to have been building a Wordfeud (Scrabble clone) game in Mathematica.

My interactive Wordfeud board in Mathematica

I used DictionaryLookup with StringExpression to find matches corresponding to my hand (7 letters) and the fixed letters in the same row on the board that can be used. With 15 characters on a row that would be a maximum of 8 extra letters at fixed positions.

I believe Mr.wizard's solution of generating all permutations would be unbearably slow in this case. I wonder whether the mma.se community has better ideas for this variant.

Being far removed from my own MMA installation I can't currently post what I've got so far, but will do so this weekend. My solution typically took somewhere around 10-20 secs if memory serves, which is a tad slow.

The next step-up in complexity would be having to deal with all potential words crossing your row. Extra points if you have ideas to tackle that efficiently.

-
I wrote this a while back that may or may not have some useful code buried in it. I don't have time at the moment to formulate a real answer from it. –  Andy Ross May 3 '12 at 14:32
Would you provide a solid example? I think I understand what you're asking, but I would like to be sure before I give my vote. –  Mr.Wizard May 3 '12 at 17:56
@Mr.Wizard I think the example given by Simon in his first two code lines is a good one. Would that work for you? –  Sjoerd C. de Vries May 3 '12 at 18:22

My attempt:

First we define the existing row, using dots to represent empty squares, and our hand of 7 letters.

row="...t.t...r..e..";
letters="aodalip";


Next define a function to count how many times each of our letters appears in a given string. Also run this function on our letters, to count how many of each we have.

lettercount[str_]:=StringCount[str,#]&/@Characters[letters];
mylettercounts=lettercount[letters];


Next consider where our new word could start and finish. It can't start immediately to the right of an existing letter, nor can it finish immediately to the left of an existing letter.

cantstarthere=StringPosition[row,Except["."]][[All,1]]+1;
startpoints=Complement[Range[14],cantstarthere];
cantendhere=cantstarthere-2;
endpoints=Complement[1+Range[14],cantendhere];


Now that we have the list of valid start and end points, construct a list of substrings of row that could become our new word. It is also handy to keep note of what the start point is for each one. An additional constraint is that our new word must include one of the existing letters, so we remove any substrings of row which are all dots.

subrows=Flatten[Table[{m,StringTake[row,{m,n}]},{m,startpoints},{n,Select[endpoints,#>m&]}],1];
subrows=Select[subrows,Not@StringMatchQ[#[[2]],"."..]&];


Now convert each substring of row into a regular expression, replacing each dot with ([any of our letters]).

starts=subrows[[All,1]];
regexes=StringReplace[subrows[[All,2]],"."->"(["<>letters<>"])"];


Next we search the dictionary for any words matching the regular expression. A slight wrinkle is that we might have used one of our letters twice, so we use the regular expression again in StringCases to pick out which letters were used to match the ([any of our letters]) templates. We use this information to weed out any words which we can't actually make.

results=Table[
reg=regexes[[j]];
possiblewords=DictionaryLookup[RegularExpression[reg]];
lettersused=Flatten[StringCases[#,RegularExpression[reg]->"$1$2$3$4$5$6$7"]&/@possiblewords]; okay=(Max[(lettercount[#]-mylettercounts)]<1)&/@lettersused; {starts[[j]],Pick[possiblewords,okay]} ,{j,Length[regexes]}];  Finally do a bit of tidying up, and present the words we can make along with their start points. Column[DeleteDuplicates[Flatten[#]]&/@SplitBy[Select[results,#[[2]]!={}&],First]/.{a_Integer,b__}:>Rule[a,{b}]] 1->{dolt,plot} 2->{apt,dot,lit,lot,oat,opt,pat,pit,pot} 3->{at,it} 4->{tat,tot,total} 6->{ta,ti,to,tad,tap,til,tip,top,tapir} 8->{air,oar,par,lard,lira,lord,para,parade,parole,paroled} 9->{or,pro,drape,pride,prole} 10->{rape,ride,rile,ripe,rode,role,rope,raped,riled,riped,roped} 12->{lea,led,lei,pea,deal,deli,lead,leap,peal}  - There are some very good ideas here. I'll have to wait for the weekend to fully work through this. There's one thing where you have me wondering and that's the starting and stopping criteria. AFAIK there's no rule against starting to the right of a letter and stopping to the left of one. As long as the final word is a single, continuous one in the dictionary you may distribute your letters over the row in any way you like. – Sjoerd C. de Vries May 3 '12 at 16:40 The letters you place on the board can start to the right of an existing letter, but then that existing letter becomes part of the word. The starting and stopping criteria refer to the entire finished word, not the letters you place. For example if the row is "...k.o.." you can't search the dictionary for ".o." and find "dog" because then you'd have "kdog" which isn't a word. Does that make sense? – Simon Woods May 3 '12 at 20:36 I'm looking for a word following Wordfeud's rules. So, if the word starts with an existing letter that's fine with me. 'known' would be an example here that would work given your letters on the board and assuming 'nwn' in your hand. – Sjoerd C. de Vries May 3 '12 at 20:47 However, rereading your sentences, I begin to get the feeling that I might be misinterpreting your words. I'll give it some more time to let it seep in. – Sjoerd C. de Vries May 3 '12 at 20:57 With .e... on the board adding the dictionary word 'go' you'd get .ego. which is also a dictionary word. But I get your point. It's unnecessary to look for words starting there. – Sjoerd C. de Vries May 3 '12 at 21:07 show 1 more comment Would this do the trick? selectWords[chars_, min_, max_] := Module[{charsset = Union[chars], charstally = Tally[chars], baselist, baselistchars, baselistpicks}, baselist = ToLowerCase[DictionaryLookup[x__ /; min <= StringLength[x] <= max]]]; baselistchars = Select[Characters /@ baselist, Complement[#, charsset] === {} &]; baselistpicks = Complement[Tally@#, charstally, SameTest -> (#1[[1]] === #2[[1]] && #1[[2]] <= #2[[2]] &)] === {} & /@ (baselistchars); Pick[StringJoin /@ baselistchars, baselistpicks] ]  Given a list of 15 chars: mychars = Join[Characters["micasat"], Characters["aueiofgh"]] selectWords[mychars, 4, 9] // Length // AbsoluteTiming (* ===> {1.241242, 683} *)  EDIT: Using regular expressions seems to be faster: charsToRegular[chars_] := RegularExpression[ StringJoin[ "^", (# <> "{0," <> ToString[#2] <> "}") & @@@ Sort[Tally[chars]], "$"]]

selectWordsRE[chars_, min_, max_] :=
With[{re = charsToRegular[chars],
allcases =
ToLowerCase[
DictionaryLookup[x__ /; min <= StringLength[x] <= max]]},
Pick[allcases,
StringMatchQ[StringJoin[Sort[Characters@#]] & /@ allcases, re]]
]


Testing it:

selectWordsRE[mychars, 4, 8] // Length // AbsoluteTiming
(*
===> {0.990980, 683}
*)

selectWordsRE[mychars, 4, 8] === selectWords[mychars, 4, 8]
(*
===> True
*)


Given that the 8 characters have a fixed order, after applying selectWordsRE we can do something like this to filter only the characters that fix in the board:

fixedboard = "..a..e.io.f.ugh"


We define:

boardToRE2[board_, len_] :=
RegularExpression[
StringJoin@
Riffle[With[{res =
Union[Table[
StringTake[board, {i, i + len - 1}], {i,
StringLength[board] - len + 1}]]},
If[StringMatchQ[res[[1]], "." ..], res[[;; 1]], res]], "|"]]

filterByBoard[board_, words_] :=
Flatten[Table[
With[{re = boardToRE2[board, StringLength[group[[1]]]]},
Pick[group, StringMatchQ[group, re]]], {group,
GatherBy[words, StringLength]}]]


Then we can test it with the previous example:

candidates = selectWordsRE[mychars, 4, 8];

(filtered = filterByBoard[fixedboard, candidates]) // Length // AbsoluteTiming

(*
===> {0.001720, 181}
*)

-
Thanks! Working from my iPad so can't go to deep into this: so two remarks: First, DictionaryLookup has an option IgnoreCase, so case conversion seems unnecessary. Second, and I believe my question wasn't sufficiently specific in this: the fixed characters have fixed positions (determined by the current state of the board), so the code needs to accommodate that. –  Sjoerd C. de Vries May 3 '12 at 16:15
I don't use IgnoreCase because Im doing the pattern test outside DictonaryLookup. –  FJRA May 3 '12 at 21:49

I originally wrote this to help in guessing a word of known length from a bunch of letters, The word guessing game has 10 letters given so I tried to optimize this for speed. I reworked it here for scrabble:

string = "hkxefri";
words = DictionaryLookup[{Apply[Alternatives,
Characters[string]]} ..];
joined = StringJoin /@
Permutations[StringSplit[string, ""], StringLength[string]];
Select[words, MemberQ[joined, #] &]


This doesn't deal with existing letters on the row.

this code is slower but I don't know why:

joined = StringJoin /@ Permutations[Characters[string], 7];
First /@ Select[DictionaryLookup /@ joined, # != {} &]

-
Nice, but your lookup pattern seems a bit wasteful as it tests for 7^7 possible code words instead of 7!, which should be an upper limit. –  Sjoerd C. de Vries May 3 '12 at 18:35
I added some code I wrote that looked at 7! possibilities but it always seemed to be slower, don't know why. –  s0rce May 4 '12 at 2:26

As promised I'll provide the basics of my own approach here.

I needed a string pattern test to test whether a given string consists of a set of letters that is a subset of a given set of letters. Such as subset test is not a standard feature of Mathematica as far as I know.

With a bit of effort one can use MMA lists as sets. It's good to note that the lists {1,2,3} and {3,2,1} are different, whereas seen as sets they are the same. Sorting in canonical is often needed. So, here's my subset test:

subSetQ[mySet_, testSet_] := Intersection[mySet, testSet] == Sort[testSet]


Using this, finding all words using my hand and a fixed letter "e" on the board can be done this way:

mySet = {"a", "o", "d", "a", "l", "i", "p"}
DictionaryLookup[
x : ___ ~~ "e" ~~ y : ___ /; subSetQ[mySet, Join[Characters[x], Characters[y]]],
IgnoreCase -> True
]


The lengths of the stringth x and y will most often bounded. That can be incorporated in this way:

DictionaryLookup[
x : ___ ~~ "e" ~~ y : ___ /;
subSetQ[mySet, Join[Characters[x], Characters[y]]] &&
StringLength[x] <= 3 && StringLength[y] <= 3,
IgnoreCase -> True
] // AbsoluteTiming

(*
==> {4.5812620, {"aide", "ailed", "ale", "aloe", "ape", "aped",
"dale", "deal", "deli", "die", "doe", "dole", "dope", "Ed", "Eli",
`