What I'm trying to find are the 4 letter words in the Mathematica dictionary that have the most anagrams and the amount of anagrams these have each.
But I can't seem to find all the 4 letter words in the Mathematica dictionary. My output only results in 3-8 letter words. Input is below
wordperms =Flatten[Map[DictionaryLookup,Map[StringJoin, Permutations[Characters[#]]]]] &; words = DictionaryLookup[]; sorted = Sort[Map[Sort, Map[Characters, words]]]; Part[Select[Tally@sorted, Part[#, 2] > 4 &], All, 1]; found = Part[Select[Tally@sorted, Part[#, 2] > 4 &], All, 1]; Map[wordperms, found]