Introduction

Recently I have picked up a habit of tinkering with anagrams. While there are numerous algorithms and websites that do the job for you, "the goal of serious or skilled anagrammatists is to produce anagrams that in some way reflect or comment on the subject". And that requires a semantic assessment, which not every (if any) program can do. I actually find manual play with anagrams a fun puzzle-solving activity. But what can a program do for you when you told it not to do too much? Although writing on paper is very chic, it is nice to have a simple processor that helps me to type manually and think. Here is a simple interface showing the working process:

The interface consists of 3 parts:

1. AnagramPlot: sorts letters in 2 strings and depicts common and differing letters.
2. WordDirectory: prints first n words in dictionary starting with a specific letter sequence and gives definitions
3. Assembling code that also makes functions Dynamic.

Below we study how each of these work.

AnagramPlot

Example usage:

AnagramPlot["Wolfram Language", "fear no walls"]

This is a simple but curious function taking advantage of a few tricks. The following marks letters inside alphabet that are present in a string:

Alphabet[] /. x_String :> Cases[Characters["follower flower"], x]

{{},{},{},{},{"e","e"},{"f","f"},{},{},{},{},{},{"l","l","l"},{},{},{"o","o","o"},{},{},{"r","r"},{},{},{},{},{"w","w"},{},{},{}}

Another convenient thing is SequenceAlignment action on same-letter strings:

SequenceAlignment["aaaaa", "aaa"]

{{"aa", ""}, "aaa"}

which helps to build the final visualization:

ClearAll[AnagramPlot];
AnagramPlot[s1_String,s2_String]:=
With[{
    str1=Sort[ToLowerCase[StringCases[s1,LetterCharacter]]],
    str2=Sort[ToLowerCase[StringCases[s2,LetterCharacter]]]
    },
    Row[
    Grid[#,Frame->All,FrameStyle->GrayLevel[.8]]&/@
    Replace[
       Flatten[
         SequenceAlignment@@@Replace[
          Transpose[Alphabet[]/.x_String:>Cases[#,x]&/@{str1,str2}],
         {{},{}}->Nothing,{1}],
       1],
    x_List/;Depth[x]==2:>{x},{1}]
    ]
]

WordDirectory

Example usage:

WordDirectory["cat", 50]

Nothing special, but a thing to note is StartOfString, which is handy and obviously will have a different action than WordBoundary

Clear[WordDirectory];
WordDirectory[s_String,n_Integer]:=
Multicolumn[
 Tooltip[#,Column[WordData[#,"Definitions","List"],Frame->All,FrameStyle->GrayLevel[.8]]]&/@
 Take[DeleteDuplicates[Flatten[StringCases[WordData[],StartOfString ~~s~~___]]],UpTo[n]],
 4]

Note there is a simpler and faster definition via DictionaryLookup

Clear[WordDirectory];
WordDirectory[s_String,n_Integer]:=
Multicolumn[
 Tooltip[#,Column[WordData[#,"Definitions","List"],Frame->All,FrameStyle->GrayLevel[.8]]]&/@
 Take[DictionaryLookup[s~~___],UpTo[n]],
 4]

but I've chosen more clumsy method via WordData, because it gives a bit more words (not all of them usable):

WordData[] // Length

149191

DictionaryLookup[] // Length

92518

Dynamic interface

To get everything together we need some quite minimal code. This will make the app you see at the top .GIF picture in the beginning of this post. While Dynamic will make everything work on its own, it is always a good idea to localize variables with DynamicModule.

DynamicModule[
    {a="wolfram language",b="",x=""},
    Column[{
       InputField[Dynamic[a],String,ContinuousAction->True],
       InputField[Dynamic[b],String,ContinuousAction->True],
       Dynamic[AnagramPlot[a,b]],
       InputField[Dynamic[x],String,ContinuousAction->True],
       Dynamic[WordDirectory[x,32]]
    }]
]

References

• Nice @Ed Pegg anagram solver: Word Play with Mathematica
• Nice anagram solver: Andy's anagram solver!
• Anagrams demonstration

Questions

• Can you come up with more anagrams to "Wolfram Language"?
• What tools for anagrams do you suggest?
• Do you know useful for anagrams Wolfram Language code?

Please feel free to comment.