Roman Numerals
March 6, 2009
Our first function converts a Roman numeral to its numeric equivalent by indexing through the string, adding the decoded value of the current character, and subtracting double the prior value (since it was already added once, it must be subtracted twice) if a higher-value character follows a lower-value character:
(define (roman->number roman)
(let ((romans '((#\M 1000) (#\D 500) (#\C 100) (#\L 50) (#\X 10) (#\V 5) (#\I 1))))
(let loop ((roman (map char-upcase (string->list roman))) (prior 10000) (number 0))
(cond ((null? roman) number)
((< prior (cadr (assoc (car roman) romans)))
(loop (cdr roman)
10000
(+ number (cadr (assoc (car roman) romans)) (* prior -2))))
(else (loop (cdr roman)
(cadr (assoc (car roman) romans))
(+ number (cadr (assoc (car roman) romans)))))))))
Our second function goes in the other direction. It was written by Dorai Sitaram, contributed to SLIB, and stolen (as Pablo Picasso said, “Good artists copy. Great artists steal.” Don’t worry — the file header in format.scm indicates the code is in the public domain.) by us for this exercise:
(define (number->roman n)
(if (and (integer? n) (> n 0))
(let loop ((n n)
(romans '((1000 #\M) (500 #\D) (100 #\C) (50 #\L) (10 #\X) (5 #\V) (1 #\I)))
(boundaries '(100 100 10 10 1 1 #f))
(s '()))
(if (null? romans)
(list->string (reverse s))
(let ((roman-val (caar romans))
(roman-dgt (cadar romans))
(bdry (car boundaries)))
(let loop2 ((q (quotient n roman-val))
(r (remainder n roman-val))
(s s))
(if (= q 0)
(if (and bdry (>= r (- roman-val bdry)))
(loop (remainder r bdry) (cdr romans)
(cdr boundaries)
(cons roman-dgt
(append
(cdr (assv bdry romans))
s)))
(loop r (cdr romans) (cdr boundaries) s))
(loop2 (- q 1) r (cons roman-dgt s)))))))
(error 'number->roman "only positive integers can be romanized"))))
Then add-roman converts its input arguments from Roman numerals, adds them, and converts the result back to a Roman numeral:
(define (add-roman . xs)
(number->roman (apply +
(map roman->number xs)))
Note that add-roman takes any number of arguments, not necessarily two. It is available at http://programmingpraxis.codepad.org/FxDMoASG:
> (add-roman "CCCLXIX" "CDXLVIII")
"DCCCXVII"
Programming Praxis 
I started to program thinking that constructions like “IIX” for 8 are allowed. Wikipedia says that this kind of subtractive notation exists, but it seems very rare. Whatever, here is my roman->decimal.
(define roman->decimal (lambda (x) (decode-roman (string->list x)))) (define decode-roman (lambda (chars) (letrec ((decode-roman-helper (lambda (fir res akk cur) (cond ((null? res) (+ akk cur)) ((< (single-roman->decimal fir) (single-roman->decimal (car res))) (decode-roman-helper (car res) (cdr res) (- akk cur) (single-roman->decimal (car res)))) ((> (single-roman->decimal fir) (single-roman->decimal (car res))) (decode-roman-helper (car res) (cdr res) (+ cur akk) (single-roman->decimal (car res)))) (else (decode-roman-helper (car res) (cdr res) akk (+ (single-roman->decimal (car res)) cur))))))) (decode-roman-helper (car chars) (cdr chars) 0 (single-roman->decimal (car chars)))))) (define single-roman->decimal (lambda (str) (cond ((char=? str #\M) 1000) ((char=? str #\D) 500) ((char=? str #\C) 100) ((char=? str #\L) 50) ((char=? str #\X) 10) ((char=? str #\V) 5) ((char=? str #\I) 1) (else 0))))Haskell (someone more experienced than me can probably turn these into one-liners):
import Data.Map (fromList, (!)) import Data.Char import Data.List data Roman = I | V | X | L | C | D | M deriving (Enum, Eq, Ord, Read, Show) main = print $ addRoman "CCCLXIX" "CDXLVIII" values :: [(Roman, Int)] values = [(M, 1000), (D, 500), (C, 100), (L, 50), (X, 10), (V, 5), (I, 1)] fromRoman :: String -> Int fromRoman = fromRoman' . map (read . return) where fromRoman' (x:y:xs) = (if x String toRoman = map toLower . concatMap show . subtractiveStyle . toRoman' values where toRoman' [] _ = [] toRoman' ((r, v):xs) n = replicate (div n v) r ++ toRoman' xs (mod n v) subtractiveStyle :: [Roman] -> [Roman] subtractiveStyle (x:y:ys) | y == pred x && isPrefixOf [y,y,y] ys = y : succ x : subtractiveStyle (drop 3 ys) subtractiveStyle xs = xs addRoman :: String -> String -> String addRoman a b = toRoman $ fromRoman a + fromRoman bEvidently there’s only a limited selection of languages that will trigger the right formatting. My apologies.
import Data.Map (fromList, (!)) import Data.Char import Data.List data Roman = I | V | X | L | C | D | M deriving (Enum, Eq, Ord, Read, Show) main = print $ addRoman "CCCLXIX" "CDXLVIII" values :: [(Roman, Int)] values = [(M, 1000), (D, 500), (C, 100), (L, 50), (X, 10), (V, 5), (I, 1)] fromRoman :: String -> Int fromRoman = fromRoman' . map (read . return) where fromRoman' (x:y:xs) = (if x < y then -1 else 1) * val x + fromRoman' (y:xs) fromRoman' xs = sum $ map val xs val c = fromList values ! c toRoman :: Int -> String toRoman = map toLower . concatMap show . subtractiveStyle . toRoman' values where toRoman' [] _ = [] toRoman' ((r, v):xs) n = replicate (div n v) r ++ toRoman' xs (mod n v) subtractiveStyle :: [Roman] -> [Roman] subtractiveStyle (x:y:ys) | y == pred x && isPrefixOf [y,y,y] ys = y : succ x : subtractiveStyle (drop 3 ys) subtractiveStyle xs = xs addRoman :: String -> String -> String addRoman a b = toRoman $ fromRoman a + fromRoman bFalconNL: Haskell is not one of the supported languages for the WordPress sourcecode tag. See my HOWTO page for more about posting source code in comments.
At first I thought my solution was long and ugly and than I read the praxis’ Scheme solution :)
I read Roger’s Scheme but it is incomplete : no encode-roman
I read FalconNL’s Haskell and subtractiveStyle doesn’t work on numbers like 1904
So I guess I’ll roll my ugly clojure solution :
(def *romans* {\I 1, \V 5, \X 10, \L 50, \C 100, \D 500, \M 1000}) (defn from-roman [rs] (loop [rs (reverse rs) prev 0 dnum 0] (let [v (*romans* (first rs))] (cond (nil? v) dnum (< v prev) (recur (next rs) v (- dnum v)) :else (recur (next rs) v (+ dnum v)))))) (defn to-roman [d] (let [dq (quot d 1000) dr (rem d 1000) r (vec (repeat dq \M)) romans (reverse (sort-by second *romans*))] (loop [d dr romans romans r r] (if (zero? d) (apply str r) (let [[[u10 v10] [u5 v5] [u1 v1]] romans dq (quot d v1) dr (rem d v1)] (cond (= dq 9) (recur dr (nnext romans) (conj r u1 u10)) (> dq 4) (recur dr (nnext romans) (apply conj r u5 (repeat (- dq 5) u1))) (= dq 4) (recur dr (nnext romans) (conj r u1 u5)) (> dq 0) (recur dr (nnext romans) (apply conj r (repeat dq u1))) :else (recur d (nnext romans) r))))))) (defn add-roman [& rs] (to-roman (apply + (map from-roman rs))))Some use cases :
Hello everybody,
I briefly walked through all posted examples and figured out that noone completely solved this task.
kawas was very close to solution however even in his second use case user=> (add-roman “MMCCCII” “MMDCII”) result seemed to be wrong because there cannot be 4 M in a row. Please see wikipedia as a proof-link http://en.wikipedia.org/wiki/Roman_numerals
So here is my solution in Python:
rom_arab_dict = {'I' : 1, 'V' : 5, 'X' : 10, 'L' : 50, 'C' : 100, 'D' : 500, 'M' : 1000} limit_sum = 3999 def add_roman(a, b): arab_sum = roman_to_arabic(a) + roman_to_arabic(b) if arab_sum <= limit_sum: arabic_to_roman(arab_sum) print('Roman sum: %s + %s = %s' % (a, b, arabic_to_roman(arab_sum))) print('Arab sum(verification): %s + %s = %s' % (roman_to_arabic(a), roman_to_arabic(b), arab_sum)) else: print('Result sum out of range of Roman numbers.\n Should be less or equal to %d' % limit_sum) def roman_to_arabic(roman_num): sum = 0 arab_lst = [rom_arab_dict[x] for x in roman_num for y in rom_arab_dict.keys() if x == y] for index, item in enumerate(arab_lst): if index + 1 < len(arab_lst): if item < arab_lst[index + 1]: arab_lst[index] = arab_lst[index + 1] - arab_lst[index] del arab_lst[index + 1] sum += arab_lst[index] return sum def arabic_to_roman(arab_num): # dict {'key':val} to list [(v, k)] items = [(v, k) for k, v in rom_arab_dict.items()] items.sort() # reverse order from high to low items.reverse() rom_lst = [] for index, item in enumerate(items): v, k = item while arab_num - v >= 0: arab_num -= v tmp_v, tmp_k = items[index] rom_lst.append(tmp_k) if rom_lst.count(tmp_k) == 4: rom_lst = rom_lst[:-3] tmp_v, tmp_k = items[index - 1] rom_lst.append(tmp_k) return ''.join(rom_lst) #Test cases add_roman("CCCLXIX", "CDXLVIII") add_roman("CDXXVIII", "DLXXVIII") add_roman("MDCCL", "MDCLXX")Results:
Roman sum: CCCLXIX + CDXLVIII = DCCCXVII
Arab sum(verification): 369 + 448 = 817
Roman sum: CDXXVIII + DLXXVIII = MVI
Arab sum(verification): 428 + 578 = 1006
Roman sum: MDCCL + MDCLXX = MMMCDXX
Arab sum(verification): 1750 + 1670 = 3420
Cheers,
Pavel
A nice additional constraint to the problem — at least for Roman numerals in additive form — is to forbid conversion back to decimal for the purposes of carrying out the addition. This seems more authentic, given that conversion to decimal was not an option available to the classical Romans!
I discuss this approach to a solution along with some other (arguably) interesting connections on my new blog. Straight to the Python code.
How to chose between VIV and IX? I can’t seem to think of a way to follow this convention.
In coffeescript https://gist.github.com/4576731
See my code at: https://gist.github.com/4606068
https://github.com/ftt/programming-praxis/blob/master/20090306-roman-numerals/roman-numerals.py