Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,45 @@
|
|||
module Main where
|
||||
|
||||
------------------------
|
||||
-- DECODER FUNCTION --
|
||||
------------------------
|
||||
|
||||
decodeDigit :: Char -> Int
|
||||
decodeDigit 'I' = 1
|
||||
decodeDigit 'V' = 5
|
||||
decodeDigit 'X' = 10
|
||||
decodeDigit 'L' = 50
|
||||
decodeDigit 'C' = 100
|
||||
decodeDigit 'D' = 500
|
||||
decodeDigit 'M' = 1000
|
||||
decodeDigit _ = error "invalid digit"
|
||||
|
||||
-- We process a Roman numeral from right to left, digit by digit, adding the value.
|
||||
-- If a digit is lower than the previous then its value is negative.
|
||||
-- The first digit is always positive.
|
||||
|
||||
decode roman = decodeRoman startValue startValue rest
|
||||
where
|
||||
(first:rest) = reverse roman
|
||||
startValue = decodeDigit first
|
||||
|
||||
decodeRoman :: Int -> Int -> [Char] -> Int
|
||||
decodeRoman lastSum _ [] = lastSum
|
||||
decodeRoman lastSum lastValue (digit:rest) = decodeRoman updatedSum digitValue rest
|
||||
where
|
||||
digitValue = decodeDigit digit
|
||||
updatedSum = (if digitValue < lastValue then (-) else (+)) lastSum digitValue
|
||||
|
||||
------------------
|
||||
-- TEST SUITE --
|
||||
------------------
|
||||
|
||||
main = do
|
||||
test "MCMXC" 1990
|
||||
test "MMVIII" 2008
|
||||
test "MDCLXVI" 1666
|
||||
|
||||
test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark)
|
||||
where
|
||||
arabic = decode roman
|
||||
remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")"
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
module Main where
|
||||
|
||||
------------------------
|
||||
-- DECODER FUNCTION --
|
||||
------------------------
|
||||
|
||||
decodeDigit :: Char -> Int
|
||||
decodeDigit 'I' = 1
|
||||
decodeDigit 'V' = 5
|
||||
decodeDigit 'X' = 10
|
||||
decodeDigit 'L' = 50
|
||||
decodeDigit 'C' = 100
|
||||
decodeDigit 'D' = 500
|
||||
decodeDigit 'M' = 1000
|
||||
decodeDigit _ = error "invalid digit"
|
||||
|
||||
-- We process a Roman numeral from right to left, digit by digit, adding the value.
|
||||
-- If a digit is lower than the previous then its value is negative.
|
||||
-- The first digit is always positive.
|
||||
|
||||
decode roman = fst (foldl addValue (0, 0) (reverse roman))
|
||||
where
|
||||
addValue (lastSum, lastValue) digit = (updatedSum, value)
|
||||
where
|
||||
value = decodeDigit digit;
|
||||
updatedSum = (if value < lastValue then (-) else (+)) lastSum value
|
||||
|
||||
------------------
|
||||
-- TEST SUITE --
|
||||
------------------
|
||||
|
||||
main = do
|
||||
test "MCMXC" 1990
|
||||
test "MMVIII" 2008
|
||||
test "MDCLXVI" 1666
|
||||
|
||||
test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark)
|
||||
where
|
||||
arabic = decode roman
|
||||
remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")"
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
import Data.List (isPrefixOf)
|
||||
|
||||
mapping = [("M",1000),("CM",900),("D",500),("CD",400),("C",100),("XC",90),
|
||||
("L",50),("XL",40),("X",10),("IX",9),("V",5),("IV",4),("I",1)]
|
||||
|
||||
toArabic :: String -> Int
|
||||
toArabic "" = 0
|
||||
toArabic str = num + toArabic xs
|
||||
where (num, xs):_ = [ (num, drop (length n) str) | (n,num) <- mapping, isPrefixOf n str ]
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
import Data.Bifunctor (bimap)
|
||||
import Data.List (isPrefixOf, mapAccumL)
|
||||
|
||||
romanValue :: String -> Int
|
||||
romanValue =
|
||||
let tr s (k, v) =
|
||||
until
|
||||
(not . isPrefixOf k . fst)
|
||||
(bimap ((drop . length) k) (v +))
|
||||
(s, 0)
|
||||
in sum
|
||||
. snd
|
||||
. flip
|
||||
(mapAccumL tr)
|
||||
[ ("M", 1000),
|
||||
("CM", 900),
|
||||
("D", 500),
|
||||
("CD", 400),
|
||||
("C", 100),
|
||||
("XC", 90),
|
||||
("L", 50),
|
||||
("XL", 40),
|
||||
("X", 10),
|
||||
("IX", 9),
|
||||
("V", 5),
|
||||
("IV", 4),
|
||||
("I", 1)
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
mapM_
|
||||
(print . romanValue)
|
||||
[ "MDCLXVI",
|
||||
"MCMXC",
|
||||
"MMVIII",
|
||||
"MMXVI",
|
||||
"MMXVII"
|
||||
]
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
import qualified Data.Map.Strict as M
|
||||
|
||||
fromRoman :: String -> Int
|
||||
fromRoman xs = partialSum + lastDigit
|
||||
where
|
||||
(partialSum, lastDigit) = foldl accumulate (0, 0) (evalRomanDigit <$> xs)
|
||||
accumulate (partial, lastDigit) newDigit
|
||||
| newDigit <= lastDigit = (partial + lastDigit, newDigit)
|
||||
| otherwise = (partial - lastDigit, newDigit)
|
||||
|
||||
mapRoman :: M.Map Char Int
|
||||
mapRoman =
|
||||
M.fromList
|
||||
[ ('I', 1)
|
||||
, ('V', 5)
|
||||
, ('X', 10)
|
||||
, ('L', 50)
|
||||
, ('C', 100)
|
||||
, ('D', 500)
|
||||
, ('M', 1000)
|
||||
]
|
||||
|
||||
evalRomanDigit :: Char -> Int
|
||||
evalRomanDigit c =
|
||||
let mInt = M.lookup c mapRoman
|
||||
in case mInt of
|
||||
Just x -> x
|
||||
_ -> error $ c : " is not a roman digit"
|
||||
|
||||
main :: IO ()
|
||||
main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (maybe)
|
||||
|
||||
------------------ ROMAN NUMERALS DECODED ----------------
|
||||
|
||||
mapRoman :: M.Map Char Int
|
||||
mapRoman =
|
||||
M.fromList $
|
||||
zip "IVXLCDM" $
|
||||
scanl (*) 1 (cycle [5, 2])
|
||||
|
||||
fromRoman :: String -> Maybe Int
|
||||
fromRoman cs =
|
||||
let op l r
|
||||
| l >= r = (+)
|
||||
| otherwise = (-)
|
||||
in snd
|
||||
. foldr
|
||||
(\l (r, n) -> (l, op l r n l))
|
||||
(0, 0)
|
||||
<$> traverse (`M.lookup` mapRoman) cs
|
||||
|
||||
--------------------------- TEST -------------------------
|
||||
main :: IO ()
|
||||
main =
|
||||
putStrLn $
|
||||
fTable
|
||||
"Roman numeral decoding as a right fold:\n"
|
||||
show
|
||||
(maybe "(Unrecognised character seen)" show)
|
||||
fromRoman
|
||||
[ "MDCLXVI",
|
||||
"MCMXC",
|
||||
"MMVIII",
|
||||
"MMXVI",
|
||||
"MMXVII",
|
||||
"QQXVII"
|
||||
]
|
||||
|
||||
------------------------ 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)
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
import qualified Data.Map.Strict as M (Map, fromList, lookup)
|
||||
import Data.Maybe (isNothing, isJust, fromJust, catMaybes)
|
||||
import Data.List (mapAccumL)
|
||||
|
||||
mapRoman :: M.Map String Int
|
||||
mapRoman =
|
||||
M.fromList
|
||||
[ ("M", 1000)
|
||||
, ("CM", 900)
|
||||
, ("D", 500)
|
||||
, ("CD", 400)
|
||||
, ("C", 100)
|
||||
, ("XC", 90)
|
||||
, ("L", 50)
|
||||
, ("XL", 40)
|
||||
, ("X", 10)
|
||||
, ("IX", 9)
|
||||
, ("V", 5)
|
||||
, ("IV", 4)
|
||||
, ("I", 1)
|
||||
]
|
||||
|
||||
fromRoman :: String -> Int
|
||||
fromRoman s =
|
||||
let value k = M.lookup k mapRoman
|
||||
in sum . catMaybes . snd $
|
||||
mapAccumL
|
||||
(\mi (l, r, i) ->
|
||||
let mValue = value [l, r] -- mapRoman lookup of [left, right] Chars
|
||||
(lastPair, pairValue)
|
||||
| isJust mValue = (Just i, mValue) -- Pair match: index updated
|
||||
| isNothing mi || i - fromJust mi > 1 = (mi, value [l])
|
||||
| otherwise = (mi, Nothing) -- Left Char was counted in pair
|
||||
in (lastPair, pairValue))
|
||||
Nothing -- Accumulator – maybe Index to last matched Char pair
|
||||
(zip3 s (tail s ++ " ") [0 ..]) -- Indexed character pairs
|
||||
|
||||
main :: IO ()
|
||||
main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]
|
||||
Loading…
Add table
Add a link
Reference in a new issue