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)