Textonyms: Difference between revisions
Content added Content deleted
(→{{header|C++}}: minor modifications) |
m (→{{header|Haskell}}: Tidied) |
||
| Line 1,124: | Line 1,124: | ||
Or, in terms of ''Data.Map'' and ''traverse'': |
Or, in terms of ''Data.Map'' and ''traverse'': |
||
<lang haskell>import Data. |
<lang haskell>import Data.Function (on) |
||
import Data.List (groupBy, maximum, sortBy, sortOn) |
|||
import qualified Data.Map as M |
import qualified Data.Map as M |
||
import Data.Maybe (mapMaybe) |
import Data.Maybe (mapMaybe) |
||
import Data.Ord (comparing) |
import Data.Ord (comparing) |
||
import Data.Function (on) |
|||
------------------------ TEXTONYMS ----------------------- |
|||
digitEncoded :: M.Map Char Char -> [String] -> [(String, String)] |
digitEncoded :: M.Map Char Char -> [String] -> [(String, String)] |
||
digitEncoded dict = |
digitEncoded dict = |
||
mapMaybe $ |
|||
((>>=) . traverse (`M.lookup` dict)) |
|||
<*> curry Just |
|||
charDict :: M.Map Char Char |
charDict :: M.Map Char Char |
||
charDict = |
charDict = |
||
M.fromList $ |
M.fromList $ |
||
concat $ |
concat $ |
||
zipWith |
zipWith |
||
(fmap . flip (,)) |
(fmap . flip (,)) |
||
(head . show <$> [2 ..]) |
(head . show <$> [2 ..]) |
||
(words "abc def ghi jkl mno pqrs tuv wxyz") |
(words "abc def ghi jkl mno pqrs tuv wxyz") |
||
definedSamples |
definedSamples :: |
||
Int -> |
|||
[[(String, String)]] -> |
|||
[[(String, String)] -> Int] -> |
|||
[[[(String, String)]]] |
|||
definedSamples n xs fs = |
definedSamples n xs fs = |
||
[take n . flip sortBy xs] <*> (flip . comparing <$> fs) |
[take n . flip sortBy xs] <*> (flip . comparing <$> fs) |
||
--------------------------- TEST |
--------------------------- TEST ------------------------- |
||
main :: IO () |
main :: IO () |
||
main = do |
main = do |
||
| Line 1,160: | Line 1,165: | ||
mapM_ |
mapM_ |
||
putStrLn |
putStrLn |
||
[ "There are " |
[ "There are " |
||
show (length encodings) |
<> show (length encodings) |
||
" words in " |
<> " words in " |
||
<> fp |
|||
<> " which can be represented by the digit key mapping.", |
|||
"They require " |
|||
| ⚫ | |||
<> show (length codeGroups) |
|||
<> " digit combinations to represent them.", |
|||
| ⚫ | |||
| ⚫ | |||
| ⚫ | |||
] |
] |
||
let codeLength = length . snd . head |
let codeLength = length . snd . head |
||
| Line 1,174: | Line 1,181: | ||
mapM_ putStrLn $ |
mapM_ putStrLn $ |
||
"Five most ambiguous:" : |
"Five most ambiguous:" : |
||
fmap (showTextonym wa) ambiguous |
fmap (showTextonym wa) ambiguous |
||
"" : "Five longest:" : fmap (showTextonym wl) longer |
<> ("" : "Five longest:" : fmap (showTextonym wl) longer) |
||
------------------------- DISPLAY |
------------------------- DISPLAY ------------------------ |
||
showTextonym :: Int -> [(String, String)] -> String |
showTextonym :: Int -> [(String, String)] -> String |
||
showTextonym w ts = |
showTextonym w ts = |
||
concat [rjust w ' ' (snd (head ts)), " -> ", unwords $ fmap fst ts] |
concat [rjust w ' ' (snd (head ts)), " -> ", unwords $ fmap fst ts] |
||
where |
where |
||
rjust n c = (drop . length) <*> (replicate n c |
rjust n c = (drop . length) <*> (replicate n c <>)</lang> |
||
{{Out}} |
{{Out}} |
||
<pre>There are 24978 words in unixdict.txt which can be represented by the digit key mapping. |
<pre>There are 24978 words in unixdict.txt which can be represented by the digit key mapping. |
||