Data update

Task/Textonyms/Pluto/textonyms.pluto

@@ -0,0 +1,53 @@
+local fmt = require "fmt"
+
+$define DIGITS = "22233344455566677778889999"
+
+local word_list = "unixdict.txt"
+local map = {}
+local count_valid = 0
+local nl = os.platform == "windows" ? "\r\n" : "\n"
+local words = io.contents(word_list):rstrip():split(nl)
+for words as word do
+    local valid = true
+    local sb = ""
+    local lword = word:lower()
+    for i = 1, #lword do
+        local c = lword[i]
+        if not("a" <= c <= "z") then
+            valid = false
+            break
+        end
+        sb ..= DIGITS[c:byte() - 96]
+    end
+    if valid then
+        count_valid += 1
+        if map[sb] then
+            map[sb]:insert(word)
+        else
+            map[sb] = {word}
+        end
+    end
+end
+
+local t = map:filtered(|v| -> #v > 1)
+local textonyms = t:keys():map(|k| -> {k, t[k]})
+local report = $"There are {count_valid} words in '{word_list}' " ..
+             "which can be represented by the digit key mapping.\n" ..
+             $"They require {#map:keys()} digit combinations to represent them.\n" ..
+             $"{#textonyms} digit combinations represent Textonyms.\n"
+print(report)
+
+local longest = textonyms:sorted(|i, j| -> #j[1] < #i[1])
+local ambiguous = longest:sorted(|i, j| -> #j[2] < #i[2])
+
+print("Top 8 in ambiguity: \n")
+print("Count   Textonym  Words")
+print("======  ========  =====")
+local f = "%4d    %-8s  %s"
+for ambiguous:slice(1, 8) as a do fmt.print(f, #a[2], a[1], a[2]:concat(" ")) end
+
+f = f:replace("8", "14")
+print("\nTop 6 in length:\n")
+print("Length  Textonym        Words")
+print("======  ==============  =====")
+for longest:slice(1, 6) as l do fmt.print(f, #l[1], l[1], l[2]:concat(" ")) end

Task/Textonyms/PowerShell/textonyms.ps1

@@ -0,0 +1,45 @@
+$url  = "http://www.puzzlers.org/pub/wordlists/unixdict.txt"
+$file = "$env:TEMP\unixdict.txt"
+(New-Object System.Net.WebClient).DownloadFile($url, $file)
+$unixdict = Get-Content -Path $file
+
+[string]$alpha = "abcdefghijklmnopqrstuvwxyz"
+[string]$digit = "22233344455566677778889999"
+
+$table = [ordered]@{}
+
+for ($i = 0; $i -lt $alpha.Length; $i++)
+{
+    $table.Add($alpha[$i], $digit[$i])
+}
+
+$words = foreach ($word in $unixdict)
+{
+    if ($word -match "^[a-z]*$")
+    {
+        [PSCustomObject]@{
+            Word   = $word
+            Number = ($word.ToCharArray() | ForEach-Object {$table.$_}) -join ""
+        }
+    }
+}
+
+$digitCombinations = $words | Group-Object -Property Number
+
+$textonyms = $digitCombinations | Where-Object -Property Count -GT 1 | Sort-Object -Property Count -Descending
+
+Write-Host ("There are {0} words in {1} which can be represented by the digit key mapping." -f $words.Count, $url)
+Write-Host ("They require {0} digit combinations to represent them."                        -f $digitCombinations.Count)
+Write-Host ("{0} digit combinations represent Textonyms.`n"                                 -f $textonyms.Count)
+
+Write-Host "Top 5 in ambiguity:"
+$textonyms | Select-Object -First 5 -Property Count,
+                                              @{Name="Textonym"; Expression={$_.Name}},
+                                              @{Name="Words"   ; Expression={$_.Group.Word -join ", "}} | Format-Table -AutoSize
+Write-Host "Top 5 in length:"
+$textonyms | Sort-Object {$_.Name.Length} -Descending |
+             Select-Object -First 5 -Property @{Name="Length"  ; Expression={$_.Name.Length}},
+                                              @{Name="Textonym"; Expression={$_.Name}},
+                                              @{Name="Words"   ; Expression={$_.Group.Word -join ", "}} | Format-Table -AutoSize
+
+Remove-Item -Path $file -Force -ErrorAction SilentlyContinue

Task/Textonyms/R/textonyms.r

@@ -0,0 +1,24 @@
+library(stringr)
+
+unixdict <- read.table("unixdict.txt", col.names="words")
+regexps <- c("[abc]","[def]","[ghi]","[jkl]","[mno]","[pqrs]","[tuv]","[wxyz]")
+replace_regexp <- function(s,n) str_replace_all(s, regexps[n], as.character(n+1))
+funs_list <- lapply(1:8, function(n) function(s) replace_regexp(s,n))
+textify <- function(s) Reduce(function(x,f) f(x), funs_list, init=s)
+unixdict$textified <- unixdict$words |> str_to_lower() |> textify()
+
+valid_text <- subset(unixdict, !str_detect(words, "[^a-z]"))
+num_combinations <- valid_text$textified |> unique() |> length()
+is_textonym <- function(s) length(subset(valid_text, textified==s)$words)>1
+num_textonyms <- Filter(is_textonym, valid_text$textified) |> unique() |> length()
+
+find_textonyms <- function(n){
+  s <- as.character(n)
+  subset(unixdict, textified==s)$words
+}
+
+str_glue("There are {length(valid_text$words)} words in unixdict.txt which can be represented by the digit key mapping.",
+         "They require {num_combinations} digit combinations to represent them.",
+         "{num_textonyms} digit combinations represent Textonyms.", .sep="\n")
+
+find_textonyms(2253)

Task/Textonyms/VBScript/textonyms.vbs

@@ -0,0 +1,47 @@
+Set objFSO = CreateObject("Scripting.FileSystemObject")
+Set objInFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_
+	"\unixdict.txt",1)
+Set objKeyMap = CreateObject("Scripting.Dictionary")
+	With objKeyMap
+		.Add "ABC", "2" : .Add "DEF", "3" : .Add "GHI", "4" : .Add "JKL", "5"
+		.Add "MNO", "6" : .Add "PQRS", "7" : .Add "TUV", "8" : .Add "WXYZ", "9"
+	End With
+
+'Instantiate or Intialize Counters
+TotalWords = 0
+UniqueCombinations = 0
+Set objUniqueWords = CreateObject("Scripting.Dictionary")
+Set objMoreThanOneWord = CreateObject("Scripting.Dictionary")
+
+Do Until objInFile.AtEndOfStream
+	Word = objInFile.ReadLine
+	c = 0
+	Num = ""
+	If Word <> "" Then
+		For i = 1 To Len(Word)
+			For Each Key In objKeyMap.Keys
+				If InStr(1,Key,Mid(Word,i,1),1) > 0 Then
+					Num = Num & objKeyMap.Item(Key)
+					c = c + 1
+				End If
+			Next
+		Next
+		If c = Len(Word) Then
+			TotalWords = TotalWords + 1
+			If objUniqueWords.Exists(Num) = False Then
+				objUniqueWords.Add Num, ""
+				UniqueCombinations = UniqueCombinations + 1
+			Else
+				If objMoreThanOneWord.Exists(Num) = False Then
+					objMoreThanOneWord.Add Num, ""
+				End If
+			End If
+		End If
+	End If
+Loop	
+
+WScript.Echo "There are " & TotalWords & " words in ""unixdict.txt"" which can be represented by the digit key mapping." & vbCrLf &_
+			 "They require " & UniqueCombinations & " digit combinations to represent them." & vbCrLf &_
+                         objMoreThanOneWord.Count &  " digit combinations represent Textonyms."
+
+objInFile.Close