Textonyms: Difference between revisions

1,444 bytes added ,  2 years ago
Line 2,030:
They require 22908 digit combinations to represent them.
1473 digit combinations represent Textonyms.</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<lang Mathematica>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</lang>
{{out}}
<pre>Number of words from Textonyms/wordlist are: 71125
Number of unique numbers: 7030
Most with the same number:
{2,6,6,6} {AMON,COMO,CONN,ANON}
5 longest words with textonyms:
{2,4,6,6,4,7,4,6,4} {CHONGQING,AGONISING}
{3,5,3,2,8,4,6,6} {EJECTION,ELECTION}
{2,8,7,8,4,3,7,8} {BUSTIEST,CURVIEST}
{2,8,7,3,8,8,3,7} {BURETTES,CURETTES}
{3,7,8,2,8,3,7} {EQUATES,ESTATES}</pre>
 
=={{header|Nim}}==
1,111

edits