Roman Numerals in Haskell

abusing pattern matching for the greater good

Roman numerals have the interesting property that they’re easily modeled by a list, and that addition is just mashing all the digits in both numbers together, then ordering all the digits and reducing them by some very simple replacement rules. This makes them a fun way to show off basic pattern matching and a recursive reduction in Haskell.

First the imports and such. Pretty simple.

{-# LANGUAGE FlexibleInstances #-}

import Data.List 

We can define our digits as follows. We’ll add an overlapping instance to show roman numerals, because in our case it makes more sense to order the digits from I to M under the hood, but we’ll need to print them in the correct order from M to I.

data RomanDigit = I | V | X | L | C | D | M
  deriving (Enum, Eq, Ord, Read, Show)

type RomanNum = [RomanDigit]
instance {-# OVERLAPPING #-} Show RomanNum
  where show xs = concatMap show $ reverse xs

We can already define addition as described above, but we’ll need to defer our condense function to the next step. We just mash the digits together, sort, and condense.

romadd :: RomanNum -> RomanNum -> RomanNum
a `romadd` b = condense . sort $ a ++ b

The condensing rules are super simple. condense takes a sorted list of digits from low to high values. If we see IIIII, we replace with V. If we see VV, we replace with X. And so on. We define a helper replaceWith function here to keep the list sorted and move on to the next condensation.

replaceWith a b = condense . sort $ a : b

condense (I:I:I:I:I:xs) = replaceWith V xs
condense (V:V:xs) = replaceWith X xs
condense (X:X:X:X:X:xs) = replaceWith L xs
condense (L:L:xs) = replaceWith C xs
condense (C:C:C:C:C:xs) = replaceWith D xs
condense (D:D:xs) = replaceWith M xs
condense num@(M:_) = num
condense (x:xs) = x : condense xs
condense [] = []

Finally, with a bit of elided quasiquotation magic, we have roman numerals that can be simplified as well as added with the most stupid-simple addition algorithm ever created.

main = do
  print $ condense [roman|MMDCXVVVIIIIII|] -- MMDCXXXI
  print $ [roman|VIII|] `romadd` [roman|XVII|] -- XXV