Textonyms: Difference between revisions

Line 908:

import Data.Function (on)

digitEncoded :: [String] -> [(String, String)]

digitEncoded :: M.Map Char Char -> [String] -> [(String, String)]

digitEncoded = mapMaybe ((>>=) . traverse ~~toKey~~ <*> curry Just)

digitEncoded dict = mapMaybe $ (>>=) . traverse (`M.lookup` dict) <*> curry Just

⚫

where

toKey = flip M.lookup charDict

charDict :: M.Map Char Char

Line 921:

Line 919:

(head . show <$> [2 ..])

(words "abc def ghi jkl mno pqrs tuv wxyz")

⚫

showTextonym :: Int -> [(String, String)] -> String

⚫

showTextonym w ts =

⚫

concat [rjust w ' ' (snd (head ts)), " -> ", unwords $ fmap fst ts]

where

⚫

rjust n c = (drop . length) <*> (replicate n c ++)

--------------------------- TEST ---------------------------

Line 933:

Line 926:

let fp = "unixdict.txt"

s <- readFile fp

let encodings = digitEncoded $ lines s

let encodings = digitEncoded charDict $ lines s

codeGroups = groupBy (on (==) snd) . sortOn snd $ encodings

textonyms = filter ((1 <) . length) codeGroups

ambiguous = take 5 $ sortBy (flip (comparing length)) textonyms

longer = take 5 $ sortBy (flip (comparing (length . snd . head))) textonyms

[wa, wl] = (maximum . map (length . snd . head)) <$> [ambiguous, longer]

[wa, wl] = maximum . map (length . snd . head) <$> [ambiguous, longer]

mapM_ putStrLn $

[ "There are " ++

Line 951:

Line 944:

] ++

fmap (showTextonym wa) ambiguous ++

["", "5 longest:"] ++ fmap (showTextonym wl) longer~~</lang>~~

["", "5 longest:"] ++ fmap (showTextonym wl) longer

------------------------- DISPLAY --------------------------

⚫

showTextonym :: Int -> [(String, String)] -> String

⚫

showTextonym w ts =

⚫

concat [rjust w ' ' (snd (head ts)), " -> ", unwords $ fmap fst ts]

⚫

where

⚫

rjust n c = (drop . length) <*> (replicate n c ++)</lang>

<pre>There are 24978 words in unixdict.txt which can be represented by the digit key mapping.