module Roman where import Numeric (readDec) import Maybe (fromJust, fromMaybe) import Char (toUpper) {- Roman Numerals. You can use toRoman and fromRoman directly -- if you wish. You can also compile this module as a program and -- use it at the commandline under the names toRoman or fromRoman, -- depending on the sense you want the conversion. Note, there isn't -- any error-checking on the input strings, and we use limited precision -- Ints because surely no-one wants to play with roman numerals any -- larger than that! -- Author: Malcolm.Wallace@cs.york.ac.uk, 29 July 1999 -} toRoman :: Int -> String fromRoman :: String -> Int -- Each numeral has a decimal value. numerals = [ ('I', 1), ('V', 5), ('X', 10), ('L', 50), ('C', 100), ('D', 500), ('M',1000) ] -- For each numeral, there is a single permitted prefix digit for subtraction. subnums = [ ('V','I'), ('X','I'), ('L','X'), ('C','X'), ('D','C'), ('M','C') ] -- Traverse the numeral list with an accumulator consisting of the -- string built so far (in reverse order) and the remaining value to be -- converted. toRoman n = (reverse . snd) (foldr toNumeral (n,"") numerals) -- Each numeral could potentially appear many times (case 1), and we must -- also handle (case 2) where a numeral *nearly* fits so we use a subtractive -- prefix. toNumeral st@(rdigit, base) (n,s) | n >= base = toNumeral st (n-base, rdigit:s) | n+k >= base = (n-base+k, rdigit:tdigit:s) | otherwise = (n,s) where tdigit = fromMaybe '\0' (lookup rdigit subnums) k = fromMaybe 0 (lookup tdigit numerals) -- The inverse is pretty straightforward by comparison. First, divide -- up the string into chunks of identical letters, and add those together -- (maxmunch). Then accumulate these from the right - an intermediate -- letter-sum which is less than the value already accumulated means it -- must be a prefix subtraction (fromNumeral) rather than an addition. fromRoman = foldr fromNumeral 0 . maxmunch . map toUpper fromNumeral x y | x < y = y-x | x > y = y+x maxmunch "" = [] maxmunch string@(x:_) = let (these,those) = span (x==) string length [] = 0 length (x:xs) = 1 + length xs in fromJust (lookup x numerals) * length these : maxmunch those -- Now just some tidying up so we can call the program from the -- commandline. safeRead s = case readDec s of [] -> 0 ((n,_):_) -> n