Message Boards Message Boards

Anagram ramble in "log raw fun agleam"

GROUPS:

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:

enter image description here

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"]

enter image description here

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]

enter image description here

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

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.

POSTED BY: Vitaliy Kaurov
Answer
8 months ago

Very neat! Thanks for sharing!

POSTED BY: Sander Huisman
Answer
8 months ago

Group Abstract Group Abstract