This is an interesting puzzle. I think, though, you should restrict yourself to only words of length 4, to save processing time, as follows:
words = DictionaryLookup[Repeated[CharacterRange["a", "z"], {4}]];
where I used CharacterRange
to eliminate proper names and contractions. This has the side effect that all accent marks, umlauts, etc. are also removed. As to creating the actual anagram list, my solution involves creating a hash table, of sorts.
ClearAll[anagrams];
SetAttributes[anagrams, Orderless];
anagrams[__] := {};
anagrams[s_String] := anagrams[Sequence @@ Characters[s]]
where these initial definitions of anagrams
provides some helper code. To use this as a hash table, we need to feed in the words, as follows
(anagrams[Sequence @@ Characters[#]] = {#}~Join~anagrams[#]) & /@ words
It isn't the most elegant construction. For illustration sake, let
words = {"hat", "cat", "tac"}
then
DownValues@anagrams
(*
{HoldPattern[anagrams["a", "c", "t"]] :> {"tac", "cat"},
HoldPattern[anagrams["a", "h", "t"]] :> {"hat"},
HoldPattern[anagrams[s_String]] :> anagrams[Sequence @@ Characters[s]],
HoldPattern[anagrams[__]] :> {}}
*)
So, after running it on the real set of words
, we just need to extract the data:
data = Cases[DownValues@anagrams,
HoldPattern[Verbatim[HoldPattern][anagrams[a : Repeated[_, {4}]]] :> vals_] :>
{a} -> vals, Infinity];
and process it
Reverse[SortBy[data, Length@Last[#] &]][[;; 10]]
(*
{{"a", "e", "s", "t"} -> {"teas", "seat", "sate", "etas", "eats", "east", "ates"},
{"o", "p", "s", "t"} -> {"tops", "stop", "spot", "pots", "post", "opts"},
{"o", "s", "t", "w"} -> {"wost", "twos", "tows", "swot", "stow"},
{"a", "p", "r", "t"} -> {"trap", "tarp", "rapt", "prat", "part"},
{"a", "l", "s", "t"} -> {"slat", "salt", "lats", "last", "alts"},
{"a", "i", "l", "r"} -> {"rial", "rail", "lira", "liar", "lair"},
{"a", "e", "l", "s"} -> {"seal", "sale", "leas", "lase", "ales"},
{"i", "n", "p", "s"} -> {"spin", "snip", "pins", "nips"},
{"i", "k", "n", "s"} -> {"skin", "sink", "kins", "inks"},
{"h", "s", "t", "u"} -> {"tush", "thus", "shut", "huts"}}
*)
To make the process above a little less ad-hoc,
Clear[findAnagrams];
findAnagrams[words:{__String}]:=
Block[{anagrams, data},
SetAttributes[anagrams, Orderless];
anagrams[__] := {};
anagrams[s_String] := anagrams[Sequence@@Characters[s]];
(anagrams[Sequence@@Characters[#]] = {#}~Join~anagrams[#])& /@ words;
Cases[DownValues@anagrams,
HoldPattern[Verbatim[HoldPattern][anagrams[a__String]]:> vals_]:> {a}-> vals,
Infinity]
]