Moderator's note: TRY APP HERE (enter any word). Read about below.
There is an interesting word puzzle in Charles Babbbage's autobiography "Passages from the life of a Philosopher". He calls this word puzzle "squaring words": Given any word, try to find a symmetrical square of letters where each row and column is a valid word in the English language and the first row and column is filled by the given word. For example, consider it with the given word "DEAN". Then a possible solution would be:
D E A N
E A S E
A S K S
N E S T
Note how the first row and column are filled with the given word DEAN and the remaining columns are filled with English words: EASE (row and column 2), ASKS (row and column 3), and NEST (row and column 4).
Here is a simple implementation in the Wolfram Language, which computes all solutions for a given word (relative to the dictionary of words defined by WordList[]):
wordsquare[s_String] := Module[{n = StringLength[s], c = {{Characters[s]}}, w, m = 1},
w = Characters /@ Select[WordList[], StringMatchQ[#, Repeated[_, {n}]] &];
NestWhile[computewords[w, n, m++, #] &, c, m < n &]
]
The helper function 'computewords' helps to find words given one or more starting letters:
computewords[w_,n_Integer,m_Integer,c_List]:=
Flatten[DeleteCases[Map[Cases[w,p:Append[#[[All,m+1]],Repeated[_,{n-m}]]:>Append[#,p]]&,c],{}],1]
Let's take a look at some simple solutions first. Suppose the given word is 'on'. The 'wordsquare' function finds two solutions:
Grid /@ wordsquare["on"]
Here is a three letter word 'the'. The number of possible solutions shoots up quickly:
Grid /@ wordsquare["the"]
And here is a five letter word 'there' with 14 solutions:
Grid /@ wordsquare["there"]
Longer words may not have a solution:
wordsquare["absolutely"] (* returns the empty list {} *)
Now let's deploy this function as a FormPage to the Wolfram Cloud. We'll use the built-in function FormPage, which creates an html form with one input field (the word that you would like to solve). We need one extra helper function 'htmltable' to format the solutions into a nice simple html table format:
htmltable[e_] := "<table border='1' width='200'>" <> Map["<tr>" <> # <> "</tr>" &, Map["<td>" <> ToString[#] <> "</td>" &, e, {2}]] <> "</table><hr>";
object = CloudObject["wordsquare"];
CloudDeploy[ FormPage[{"word" -> "String"}, StringJoin[htmltable /@ wordsquare[#word]] &], object, Permissions -> "Public"];
This returns a cloud object with the following url:
https://www.wolframcloud.com/objects/user-7053ce31-817f-4643-aec1-eda27051bba6/wordsquare
If you click on the link you will be taken to the FormPage. Enter any word, for example 'heart', and click Submit to see all the solutions to the word square puzzle:
That's it! In a few lines of Wolfram Language code you can deploy a complete word square puzzle solver to share on the internet!!!