Textonyms: Difference between revisions

Line 909:

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

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

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

where

toKey = flip M.lookup charDict

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

codeGrouped = groupBy (on (==) snd) . sortOn snd

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

textonymSubset = filter ((1 <) . length)

toKey :: Char -> Maybe Char

toKey = flip M.lookup charDict

charDict :: M.Map Char Char

Line 931:

Line 924:

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

showTextonym w ts =

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

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

where

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

justifyRight :: Int -> Char -> String -> String

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

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

firstColWidth = maximum . map (length . snd . head)

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

main :: IO ()

main = do

Line 944:

Line 934:

s <- readFile fp

let encodings = digitEncoded $ lines s

codeGroups = ~~codeGrouped~~ encodings

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

textonyms = ~~textonymSubset~~ codeGroups

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] = ~~firstColWidth~~ <$> [ambiguous, longer]

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

mapM_ putStrLn $

[ "There are " ++