ClearAll[Numerify,rls] rls={"A"->2,"B"->2,"C"->2,"D"->3,"E"->3,"F"->3,"G"->4,"H"->4,"I"->4,"J"->5,"K"->5,"L"->5,"M"->6,"N"->6,"O"->6,"P"->7,"Q"->7,"R"->7,"S"->7,"T"->8,"U"->8,"V"->8,"W"->9,"X"->9,"Y"->9,"Z"->9}; Numerify[s_String]:=Characters[ToUpperCase[s]]/.rls dict=Once[Import["http://www.rosettacode.org/wiki/Textonyms/wordlist","XML"]]; dict=Cases[dict,XMLElement["pre",{},{x_}]:>x,\[Infinity]]; dict=TakeLargestBy[dict,ByteCount,1][[1]]; dict=DeleteDuplicates[StringTrim/*ToUpperCase/@StringSplit[dict]]; dict=Select[dict,StringMatchQ[(Alternatives@@Keys[rls])..]]; Print["Number of words from Textonyms/wordlist are: ",Length[dict]] grouped=GroupBy[dict[[;;;;10]],Numerify]; Print["Number of unique numbers: ",Length[grouped]] grouped=Select[grouped,Length/*GreaterThan[1]]; Print["Most with the same number:"] KeyValueMap[List,TakeLargestBy[grouped,Length,1]]//Grid Print["5 longest words with textonyms:"] List@@@Normal[ReverseSortBy[grouped,First/*Length][[;;5]]]//Grid