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