Project Euler 89 - Roman Numerals

Posted on December 17, 2013

Last updated on December 21, 2013

Problem Description

My approach is to first convert the roman numeral to an integer, and then optimally convert it back to a roman numeral. There is a different way of approaching this problem (reduce pieces like IIII to IV), but I didn’t opt for them. The solution is in Haskell.

import qualified Data.Map.Lazy as Map
import Data.Maybe
import Data.Tuple
import Control.Monad

type Roman = Char 

romans :: Map.Map Int Roman
romans = Map.fromList [(1,'I'),(5,'V'),(10,'X'),(50,'L'),(100,'C'),(500,'D'),(1000,'M')]

romansInv :: Map.Map Roman Int
romansInv = Map.fromList $ map swap $ Map.assocs romans

-- Convert Roman numerals to integer
toInt :: [Roman] -> Int
toInt [] = 0
toInt [a] = fromJust $ Map.lookup a romansInv
toInt (a:b:xs)
 | aval < bval = bval - aval + toInt xs
 | otherwise = aval + toInt (b:xs)
  where
    aval = fromJust $ Map.lookup a romansInv
    bval = fromJust $ Map.lookup b romansInv

toRoman :: Int -> [Roman]
toRoman x = concatMap getRoman (toNums x)
  where
    getRoman x = fromJust . msum $ [ fmap (:[]) $ Map.lookup x romans, subtractive x, Just $ convert x ]
    -- Find the first possible translation: Either it's already in the map, or
    -- a subtractive method can be used, or finally just the standard conversion


-- Convert a number to a list such as: 1922 -> [1000,900,20,2] 
toNums :: Int -> [Int]
toNums x = reverse $ zipWith (*) (toNumList $ x) (iterate (*10) 1)
toNumList :: Int -> [Int]
toNumList n
  | n >= 0 && n <= 9 = [n]
  | otherwise = (n `mod` 10) : toNumList (n `div` 10)

-- Converts a number without using subtractive pairings
convert :: Int -> [Roman]
convert 0 = []
convert x = r : (convert (x-i))
  where
    (i,r) = fromJust $ Map.lookupLE x romans

-- Tries to do a subtractive conversion, fails if it's impossible 
subtractive :: Int -> Maybe [Roman]
subtractive x
  | null poss        = Nothing
  | not.ok $ (r1,r2) = Nothing
  | otherwise        = Just $ r1 : r2 : [] 
  where
    poss = catMaybes $ map (flip Map.lookup romans) $ zipWith ($) [ (+1), (+10), (+100)] (repeat x)
    num  = fromJust $ flip Map.lookup romansInv $ head poss
    (r1,r2) = (fromJust $ Map.lookup (num-x) romans, head poss)

-- Checks if it's ok for r1 to preceed r2 in a subtractive tuple (r1,r2)
ok :: (Roman,Roman) -> Bool
ok a = any (== a) [('I','V'),('I','X'),('X','L'),('X','C'),('C','D'),('C','M')]


-- Should print 743
euler89 :: IO ()
euler89 = do
  contents <- readFile "roman.txt"
  print $ sum $ map (uncurry (-)) $ map (fork2 (length, length . toRoman . toInt)) (lines contents)

fork2 (f,g) x = (f x, g x)
Project Euler 89
Markdown SHA1: aed36ac5b5f5140d221fbbe9f03cf44d04955fad