65 lines
1.2 KiB
Haskell
65 lines
1.2 KiB
Haskell
import Data.List (mapAccumR)
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe (maybe)
|
|
|
|
fromRoman :: String -> Maybe Int
|
|
fromRoman cs =
|
|
let go l r
|
|
| l > r = (- r, l)
|
|
| otherwise = (r, l)
|
|
in traverse (`M.lookup` mapRoman) cs
|
|
>>= ( Just . sum . ((:) <$> fst <*> snd)
|
|
. mapAccumR go 0
|
|
)
|
|
|
|
mapRoman :: M.Map Char Int
|
|
mapRoman =
|
|
M.fromList $
|
|
zip
|
|
"MDCLXVI "
|
|
[ 1000,
|
|
500,
|
|
100,
|
|
50,
|
|
10,
|
|
5,
|
|
1,
|
|
0
|
|
]
|
|
|
|
--------------------------- TEST -------------------------
|
|
main :: IO ()
|
|
main =
|
|
putStrLn $
|
|
fTable
|
|
"Decoding Roman numbers:\n"
|
|
show
|
|
(maybe "Unrecognised character" show)
|
|
fromRoman
|
|
[ "MDCLXVI",
|
|
"MCMXC",
|
|
"MMVIII",
|
|
"MMXVI",
|
|
"MMXVIII",
|
|
"MMXBIII"
|
|
]
|
|
|
|
------------------------ FORMATTING ----------------------
|
|
fTable ::
|
|
String ->
|
|
(a -> String) ->
|
|
(b -> String) ->
|
|
(a -> b) ->
|
|
[a] ->
|
|
String
|
|
fTable s xShow fxShow f xs =
|
|
unlines $
|
|
s :
|
|
fmap
|
|
( ((<>) . rjust w ' ' . xShow)
|
|
<*> ((" -> " <>) . fxShow . f)
|
|
)
|
|
xs
|
|
where
|
|
rjust n c = drop . length <*> (replicate n c <>)
|
|
w = maximum (length . xShow <$> xs)
|