Data commit

Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-1.hs

@@ -0,0 +1,23 @@
+digit :: Char -> Char -> Char -> Integer -> String
+digit x y z k =
+  [[x], [x, x], [x, x, x], [x, y], [y], [y, x], [y, x, x], [y, x, x, x], [x, z]] !!
+  (fromInteger k - 1)
+
+toRoman :: Integer -> String
+toRoman 0 = ""
+toRoman x
+  | x < 0 = error "Negative roman numeral"
+toRoman x
+  | x >= 1000 = 'M' : toRoman (x - 1000)
+toRoman x
+  | x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r
+  where
+    (q, r) = x `divMod` 100
+toRoman x
+  | x >= 10 = digit 'X' 'L' 'C' q ++ toRoman r
+  where
+    (q, r) = x `divMod` 10
+toRoman x = digit 'I' 'V' 'X' x
+
+main :: IO ()
+main = print $ toRoman <$> [1999, 25, 944]

Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs

@@ -0,0 +1,18 @@
+import Data.Bifunctor (first)
+import Data.List (mapAccumL)
+import Data.Tuple (swap)
+
+roman :: Int -> String
+roman =
+  romanFromInt $
+  zip
+    [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
+    (words "M CM D CD C XC L XL X IX V IV I")
+
+romanFromInt :: [(Int, String)] -> Int -> String
+romanFromInt nks n = concat . snd $ mapAccumL go n nks
+  where
+    go a (v, s) = swap $ first ((>> s) . enumFromTo 1) $ quotRem a v
+
+main :: IO ()
+main = (putStrLn . unlines) (roman <$> [1666, 1990, 2008, 2016, 2018])

Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-3.hs

@@ -0,0 +1,59 @@
+module Main where
+
+------------------------
+--  ENCODER FUNCTION  --
+------------------------
+
+romanDigits = "IVXLCDM"
+
+--  Meaning and indices of the romanDigits sequence:
+--
+--    magnitude |  1 5  | index
+--   -----------|-------|-------
+--        0     |  I V  |  0 1
+--        1     |  X L  |  2 3
+--        2     |  C D  |  4 5
+--        3     |  M    |  6
+--
+--  romanPatterns are index offsets into romanDigits,
+--  from an index base of 2 * magnitude.
+
+romanPattern 0 = []      -- empty string
+romanPattern 1 = [0]     -- I or X or C or M
+romanPattern 2 = [0,0]   -- II or XX...
+romanPattern 3 = [0,0,0] -- III...
+romanPattern 4 = [0,1]   -- IV...
+romanPattern 5 = [1]     -- ...
+romanPattern 6 = [1,0]
+romanPattern 7 = [1,0,0]
+romanPattern 8 = [1,0,0,0]
+romanPattern 9 = [0,2]
+
+encodeValue 0 _ = ""
+encodeValue value magnitude = encodeValue rest (magnitude + 1) ++ digits
+  where
+    low = rem value 10 -- least significant digit (encoded now)
+    rest = div value 10 -- the other digits (to be encoded next)
+    indices = map addBase (romanPattern low)
+    addBase i = i + (2 * magnitude)
+    digits = map pickDigit indices
+    pickDigit i = romanDigits!!i
+
+encode value = encodeValue value 0
+
+------------------
+--  TEST SUITE  --
+------------------
+
+main = do
+  test "MCMXC" 1990
+  test "MMVIII" 2008
+  test "MDCLXVI" 1666
+
+test expected value = putStrLn ((show value) ++ " = " ++ roman ++ remark)
+  where
+    roman = encode value
+    remark =
+      " (" ++
+      (if roman == expected then "PASS"
+       else ("FAIL, expected " ++ (show expected))) ++ ")"