Roman numerals/Decode
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Create a function that takes a Roman numeral as its argument and returns its value as a numeric decimal integer. You don't need to validate the form of the Roman numeral.
Modern Roman numerals are written by expressing each decimal digit of the number to be encoded separately, starting with the leftmost digit and skipping any 0s. So 1990 is rendered "MCMXC" (1000 = M, 900 = CM, 90 = XC) and 2008 is rendered "MMVIII" (2000 = MM, 8 = VIII). The Roman numeral for 1666, "MDCLXVI", uses each letter in descending order.
Ada
Translation from Delphi
<lang Ada>with Ada.Text_IO;
procedure Decode_Roman_Numerals is
function Roman_To_Integer(A_Roman: String) return Integer is
function Decode_Roman_Digit (A_Char: Character) return Integer is begin case A_Char is when 'M' | 'm' => return 1000; when 'D' | 'd' => return 500; when 'C' | 'c' => return 100; when 'L' | 'l' => return 50; when 'X' | 'x' => return 10; when 'V' | 'v' => return 5; when 'I' | 'i' => return 1; when others => return 0; end case; end Decode_Roman_Digit;
L_Curr_Val: Integer; L_Last_Val: Integer;
Result: Integer; begin Result := 0;
L_Last_Val := 0;
for i in reverse 1 .. A_Roman'Length loop L_Curr_Val := Decode_Roman_Digit(A_Roman(I)); if L_Curr_Val < L_Last_Val then Result := Result - L_Curr_Val; else Result := Result + L_Curr_Val; end if; L_Last_Val := L_Curr_Val; end loop; return Result; end Roman_To_Integer;
begin
Ada.Text_IO.Put_Line(Integer'Image(Roman_To_Integer("MCMXC"))); -- 1990 Ada.Text_IO.Put_Line(Integer'Image(Roman_To_Integer("MMVIII"))); -- 2008 Ada.Text_IO.Put_Line(Integer'Image(Roman_To_Integer("MDCLXVI"))); -- 1666
end Decode_Roman_Numerals;</lang>
C
Note: the code deliberately did not distinguish between "I", "J" or "U", "V", doing what Romans did for fun. <lang C>#include <stdio.h>
int digits[26] = { 0, 0, 100, 500, 0, 0, 0, 0, 1, 1, 0, 50, 1000, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0, 10, 0, 0 };
/* assuming ASCII, do upper case and get index in alphabet. could also be
inline int VALUE(char x) { return digits [ (~0x20 & x) - 'A' ]; } if you think macros are evil */
- define VALUE(x) digits[(~0x20 & (x)) - 'A']
int decode(char * roman) {
char *bigger; int current; int arabic = 0; while (*roman != '\0') { current = VALUE(*roman); /* if (!current) return -1; note: -1 can be used as error code; Romans didn't even have zero */ bigger = roman;
/* look for a larger digit, like IV or XM */ while (VALUE(*bigger) <= current && *++bigger != '\0');
if (*bigger == '\0') arabic += current; else { arabic += VALUE(*bigger); while (roman < bigger) arabic -= VALUE(* (roman++) ); }
roman ++; } return arabic;
}
int main() {
char * romans[] = { "MCmxC", "MMVIII", "MDClXVI", "MCXLUJ" }; int i;
for (i = 0; i < 4; i++) printf("%s\t%d\n", romans[i], decode(romans[i]));
return 0;
} </lang>
C++
<lang cpp>#include <boost/array.hpp>
- include <iostream>
- include <string>
- include <algorithm>
- include <functional>
class MySearch : public std::unary_function<std::pair<std::string , int> , bool> { private : std::string value ; public :
MySearch( const std::string & word ) : value( word ) { } ; bool operator( )( const std::pair<std::string , int> &p ) const { return p.first == value ; }
} ;
int RomanToInt( const std::string &roman ) {
typedef boost::array<std::pair<std::string , int> , 7> RomanType ; typedef boost::array<std::pair<std::string , int> ,7>::const_iterator PSI ; static RomanType Romans = { std::make_pair( "I" , 1 ) , std::make_pair( "V" , 5 ) , std::make_pair( "X" , 10 ) , std::make_pair( "L" , 50 ) , std::make_pair( "C" , 100 ) , std::make_pair( "D" , 500 ) , std::make_pair( "M" , 1000 ) } ; int number = 0 ; if ( roman.length( ) == 1 ) return std::find_if( Romans.begin( ) , Romans.end( ) , MySearch( roman ) )->second ; else { int i = 0 ; while ( i < roman.length( ) ) {// look for all the letters in the array
int pos1 = std::find_if( Romans.begin( ) , Romans.end( ) , MySearch( roman.substr( i , 1 ) ))->second ; int pos2 = std::find_if( Romans.begin( ) , Romans.end( ) , MySearch( roman.substr( i + 1 , 1 ) ))->second ; if ( pos2 > pos1 ) { number += pos2 - pos1 ; i += 2 ; } else { number += pos1 ; i += 1 ; }
} } return number ;
}
int main( ) {
std::cout << "MCMXC in Roman numerals is " << RomanToInt( "MCMXC" ) << " in Arabic!\n" ; std::cout << "And MDCLXVI for the Romans is " << RomanToInt( "MDCLXVI" ) << " in better known Arabic figures!\n" ; return 0 ;
}</lang> Output:
MCMXC in Roman numerals is 1990 in Arabic! And MDCLXVI for the Romans is 1666 in better known Arabic figures!
Common Lisp
Doesn't have much in error checking: <lang lisp>(defun parse-roman (r)
(let ((sum 0)) (mapl #'(lambda (l)
(let ((a (first l)) (b (second l))) (incf sum (if (and b (< a b)) (- a) a)))) (loop for c across (string-upcase r) collect (case c (#\I 1) (#\V 5) (#\X 10) (#\L 50) (#\C 100) (#\D 500) (#\M 1000))))
sum))
- test code
(loop for r in (list "MCMXC" "MDCLXVI" "MMVIII") do
(format t "~a: ~d~%" r (parse-roman r)))</lang>output<lang>MCMXC: 1990
MDCLXVI: 1666 MMVIII: 2008</lang>
D
<lang d>import std.regex, std.algorithm;
int toArabic(string s) {
static const weights = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]; static /*const*/ symbols = ["M","CM","D","CD","C","XC", "L","XL","X","IX","V","IV","I"]; int arabic; foreach (m; match(s, "CM|CD|XC|XL|IX|IV|[MDCLXVI]")) arabic += weights[symbols.countUntil(m.hit)];
return arabic;
}
void main() {
assert(toArabic("MCMXC") == 1990); assert(toArabic("MMVIII") == 2008); assert(toArabic("MDCLXVI") == 1666);
}</lang> Alternative version: <lang d>import std.regex, std.algorithm;
int[string] w2s; static this() {
w2s = ["IX": 9, "C": 100, "D": 500, "CM": 900, "I": 1, "XC": 90, "M": 1000, "L": 50, "CD": 400, "XL": 40, "V": 5, "X": 10, "IV": 4];
}
int toArabic(string s) {
auto ms = match(s, "CM|CD|XC|XL|IX|IV|[MDCLXVI]"); return reduce!q{ a + b }(map!((m){ return w2s[m.hit]; })(ms));
}
void main() {
assert(toArabic("MCMXC") == 1990); assert(toArabic("MMVIII") == 2008); assert(toArabic("MDCLXVI") == 1666);
}</lang>
Delphi
<lang delphi>program RomanNumeralsDecode;
{$APPTYPE CONSOLE}
function RomanToInteger(const aRoman: string): Integer;
function DecodeRomanDigit(aChar: Char): Integer; begin case aChar of 'M', 'm': Result := 1000; 'D', 'd': Result := 500; 'C', 'c': Result := 100; 'L', 'l': Result := 50; 'X', 'x': Result := 10; 'V', 'v': Result := 5; 'I', 'i': Result := 1 else Result := 0; end; end;
var
i: Integer; lCurrVal: Integer; lLastVal: Integer;
begin
Result := 0;
lLastVal := 0; for i := Length(aRoman) downto 1 do begin lCurrVal := DecodeRomanDigit(aRoman[i]); if lCurrVal < lLastVal then Result := Result - lCurrVal else Result := Result + lCurrVal; lLastVal := lCurrVal; end;
end;
begin
Writeln(RomanToInteger('MCMXC')); // 1990 Writeln(RomanToInteger('MMVIII')); // 2008 Writeln(RomanToInteger('MDCLXVI')); // 1666
end.</lang>
Euphoria
<lang euphoria>constant symbols = "MDCLXVI", weights = {1000,500,100,50,10,5,1} function romanDec(sequence roman)
integer n, lastval, arabic lastval = 0 arabic = 0 for i = length(roman) to 1 by -1 do n = find(roman[i],symbols) if n then n = weights[n] end if if n < lastval then arabic -= n else arabic += n end if lastval = n end for return arabic
end function
? romanDec("MCMXCIX") ? romanDec("MDCLXVI") ? romanDec("XXV") ? romanDec("CMLIV") ? romanDec("MMXI")</lang>
Output:
1999 1666 25 954 2011
Fortran
<lang fortran>program Roman_decode
implicit none write(*,*) decode("MCMXC"), decode("MMVIII"), decode("MDCLXVI")
contains
function decode(roman) result(arabic)
character(*), intent(in) :: roman integer :: i, n, lastval, arabic
arabic = 0 lastval = 0 do i = len(roman), 1, -1 select case(roman(i:i)) case ('M','m') n = 1000 case ('D','d') n = 500 case ('C','c') n = 100 case ('L','l') n = 50 case ('X','x') n = 10 case ('V','v') n = 5 case ('I','i') n = 1 case default n = 0 end select if (n < lastval) then arabic = arabic - n else arabic = arabic + n end if lastval = n end do
end function decode end program Roman_decode</lang>
Output
1990 2008 1666
Go
For fluff, the unicode overbar is recognized as a factor of 1000, as described in WP. <lang go>package main
import (
"fmt" "os"
)
var m = map[int]int{
'I': 1, 'V': 5, 'X': 10, 'L': 50, 'C': 100, 'D': 500, 'M': 1000,
}
func parseRoman(s string) (r int, err os.Error) {
if s == "" { return 0, os.NewError("Empty string") } is := []int(s) // easier to convert string up front var c0 int // c0: roman character last read var cv0 int // cv0: value of cv
// the key to the algorithm is to process digits from right to left for i := len(is) - 1; i >= 0; i-- { // read roman digit c := is[i] k := c == 0x305 // unicode overbar combining character if k { if i == 0 { return 0, os.NewError("Overbar combining character invalid" + " at position 0") } i-- c = is[i] } cv := m[c] if cv == 0 { if c == 0x0305 { return 0, os.NewError(fmt.Sprintf( "Overbar combining character invalid at position %d", i)) } else { return 0, os.NewError(fmt.Sprintf( "Character unrecognized as Roman digit: %c", c)) } } if k { c = -c // convention indicating overbar cv *= 1000 }
// handle cases of new, same, subtractive, changed, in that order. switch { default: // case 4: digit change fallthrough case c0 == 0: // case 1: no previous digit c0 = c cv0 = cv case c == c0: // case 2: same digit case cv*5 == cv0 || cv*10 == cv0: // case 3: subtractive // handle next digit as new. // a subtractive digit doesn't count as a previous digit. c0 = 0 r -= cv // subtract... continue // ...instead of adding } r += cv // add, in all cases except subtractive } return r, nil
}
func main() {
// parse three numbers mentioned in task description for _, r := range []string{"MCMXC", "MMVIII", "MDCLXVI"} { v, err := parseRoman(r) if err != nil { fmt.Println(err) } else { fmt.Println(r, "==", v) } }
}</lang> Output:
MCMXC == 1990 MMVIII == 2008 MDCLXVI == 1666
Groovy
Solution: <lang groovy>enum RomanDigits {
I(1), V(5), X(10), L(50), C(100), D(500), M(1000); private magnitude; private RomanDigits(magnitude) { this.magnitude = magnitude } String toString() { super.toString() + "=${magnitude}" } static BigInteger parse(String numeral) { assert numeral != null && !numeral.empty def digits = (numeral as List).collect { RomanDigits.valueOf(it) } def L = digits.size() (0..<L).inject(0g) { total, i -> def sign = (i == L - 1 || digits[i] >= digits[i+1]) ? 1 : -1 total + sign * digits[i].magnitude } }
}</lang>
Test: <lang groovy>println """ Digit Values = ${RomanDigits.values()} M => ${RomanDigits.parse('M')} MCXI => ${RomanDigits.parse('MCXI')} CMXI => ${RomanDigits.parse('CMXI')} MCM => ${RomanDigits.parse('MCM')} MCMXC => ${RomanDigits.parse('MCMXC')} MMVIII => ${RomanDigits.parse('MMVIII')} MMIX => ${RomanDigits.parse('MMIX')} MCDXLIV => ${RomanDigits.parse('MCDXLIV')} MDCLXVI => ${RomanDigits.parse('MDCLXVI')} """</lang>
Output:
Digit Values = [I=1, V=5, X=10, L=50, C=100, D=500, M=1000] M => 1000 MCXI => 1111 CMXI => 911 MCM => 1900 MCMXC => 1990 MMVIII => 2008 MMIX => 2009 MCDXLIV => 1444 MDCLXVI => 1666
Haskell
<lang Haskell>import Data.List (isPrefixOf)
mapping = [("M",1000),("CM",900),("D",500),("CD",400),("C",100),("XC",90),
("L",50),("XL",40),("X",10),("IX",9),("V",5),("IV",4),("I",1)]
toArabic :: String -> Int toArabic "" = 0 toArabic str = num + toArabic xs
where (num, xs):_ = [ (num, drop (length n) str) | (n,num) <- mapping, isPrefixOf n str ]</lang>
Usage:
ghci> toArabic "MCMXC" 1990 ghci> toArabic "MMVIII" 2008 ghci> toArabic "MDCLXVI" 1666
Icon and Unicon
<lang Icon>link numbers
procedure main() every R := "MCMXC"|"MDCLXVI"|"MMVIII" do
write(R, " = ",unroman(R))
end</lang>
The code for this procedure is copied below:<lang Icon>procedure unroman(s) #: convert Roman numeral to integer
local nbr,lastVal,val
nbr := lastVal := 0 s ? { while val := case map(move(1)) of {
"m": 1000 "d": 500 "c": 100 "l": 50 "x": 10 "v": 5 "i": 1 } do { nbr +:= if val <= lastVal then val else val - 2 * lastVal lastVal := val }
} return nbr
end</lang>
Output:
MCMXC = 1990 MDCLXVI = 1666 MMVIII = 2008
J
<lang j>rom2d=: [: (+/ .* _1^ 0,~ 2</\ ]) 1 5 10 50 100 500 1000 {~ 'IVXLCDM'&i.</lang>
Example use:
<lang j> rom2d 'MCMXC' 1990
rom2d 'MDCLXVI'
1666
rom2d 'MMVIII'
2008</lang>
Java
<lang java>public class Roman{ private static int decodeSingle(char letter){ switch(letter){ case 'M': return 1000; case 'D': return 500; case 'C': return 100; case 'L': return 50; case 'X': return 10; case 'V': return 5; case 'I': return 1; default: return 0; } } public static int decode(String roman){ int result = 0; String uRoman = roman.toUpperCase(); //case-insensitive for(int i = 0;i < uRoman.length() - 1;i++){//loop over all but the last character //if this character has a lower value than the next character if(decodeSingle(uRoman.charAt(i)) < decodeSingle(uRoman.charAt(i + 1))){ //subtract it result -= decodeSingle(uRoman.charAt(i)); }else{ //add it result += decodeSingle(uRoman.charAt(i)); } } //decode the last character, which is always added result += decodeSingle(uRoman.charAt(uRoman.length()-1)); return result; }
public static void main(String[] args){ System.out.println(decode("MCMXC")); //1990 System.out.println(decode("MMVIII")); //2008 System.out.println(decode("MDCLXVI")); //1666 } }</lang> Output:
1990 2008 1666
JavaScript
<lang javascript>var Roman = {
Values: [['M', 1000], ['CM', 900], ['D', 500], ['CD', 400], ['C', 100], ['XC', 90], ['L', 50], ['XL', 40], ['X', 10], ['IX', 9], ['V', 5], ['IV', 4], ['I', 1]],
parse: function(str) { var result = 0 for (var i=0; i<Roman.Values.length; ++i) { var pair = Roman.Values[i] var key = pair[0] var value = pair[1] var regex = RegExp('^' + key) while (str.match(regex)) { result += value str = str.replace(regex, ) } } return result }
}
var test_data = ['MCMXC', 'MDCLXVI', 'MMVIII'] for (var i=0; i<test_data.length; ++i) {
var test_datum = test_data[i] print(test_datum + ": " + Roman.parse(test_datum))
}</lang>
Output:
MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008
K
<lang k> romd: {v:1 5 10 50 100 500 1000@"IVXLCDM"?/:x; +/v*_-1^(>':v),0}</lang>
Example:
<lang k> romd'("MCMXC";"MMVIII";"MDCLXVI") 1990 2008 1666</lang>
Logo
<lang logo>; Roman numeral decoder
- First, some useful substring utilities
to starts_with :string :prefix
if empty? :prefix [output "true] if empty? :string [output "false] if not equal? first :string first :prefix [output "false] output starts_with butfirst :string butfirst :prefix
end
to remove_prefix :string :prefix
if or empty? :prefix not starts_with :string :prefix [output :string] output remove_prefix butfirst :string butfirst :prefix
end
- Our list of Roman numeral values
make "values [[M 1000] [CM 900] [D 500] [CD 400] [C 100] [XC 90] [L 50]
[XL 40] [X 10] [IX 9] [V 5] [IV 4] [I 1]]
- Function to do the work
to from_roman :str
local "n make "n 0 foreach :values [ local "s make "s first ? local "v make "v last ? while [starts_with :str :s] [ make "n sum n :v make "str remove_prefix :str :s ] ] output :n
end
foreach [MCMXC MDCLXVI MMVIII] [print (sentence (word ? "|: |) from_roman ?)] bye</lang>
Output:
MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008
Lua
<lang lua>function ToNumeral( roman )
local Num = { ["M"] = 1000, ["D"] = 500, ["C"] = 100, ["L"] = 50, ["X"] = 10, ["V"] = 5, ["I"] = 1 } local numeral = 0 local i = 1 local strlen = string.len(roman) while i < strlen do local z1, z2 = Num[ string.sub(roman,i,i) ], Num[ string.sub(roman,i+1,i+1) ] if z1 < z2 then numeral = numeral + ( z2 - z1 ) i = i + 2 else numeral = numeral + z1 i = i + 1 end end if i <= strlen then numeral = numeral + Num[ string.sub(roman,i,i) ] end return numeral
end
print( ToNumeral( "MCMXC" ) )
print( ToNumeral( "MMVIII" ) )
print( ToNumeral( "MDCLXVI" ) )</lang>
1990 2008 1666
NetRexx
<lang NetRexx>/* NetRexx */ options replace format comments java crossref savelog symbols binary
/* 1990 2008 1666 */
years = Rexx('MCMXC MMVIII MDCLXVI')
loop y_ = 1 to years.words
Say years.word(y_).right(10) || ':' decode(years.word(y_)) end y_
return
method decode(arg) public static returns int signals IllegalArgumentException
parse arg.upper roman . if roman.verify('MDCLXVI') \= 0 then signal IllegalArgumentException
-- always insert the value of the least significant numeral decnum = rchar(roman.substr(roman.length, 1)) loop d_ = 1 to roman.length - 1 if rchar(roman.substr(d_, 1)) < rchar(roman.substr(d_ + 1, 1)) then do -- Handle cases where numerals are not in descending order -- subtract the value of the numeral decnum = decnum - rchar(roman.substr(d_, 1)) end else do -- Normal case -- add the value of the numeral decnum = decnum + rchar(roman.substr(d_, 1)) end end d_
return decnum
method rchar(arg) public static returns int
parse arg.upper ch +1 . select case ch when 'M' then digit = 1000 when 'D' then digit = 500 when 'C' then digit = 100 when 'L' then digit = 50 when 'X' then digit = 10 when 'V' then digit = 5 when 'I' then digit = 1 otherwise digit = 0 end
return digit
</lang> Output:
MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666
OCaml
<lang ocaml>let decimal_of_roman roman =
let arabic = ref 0 in let lastval = ref 0 in for i = (String.length roman) - 1 downto 0 do let n = match roman.[i] with | 'M' | 'm' -> 1000 | 'D' | 'd' -> 500 | 'C' | 'c' -> 100 | 'L' | 'l' -> 50 | 'X' | 'x' -> 10 | 'V' | 'v' -> 5 | 'I' | 'i' -> 1 | _ -> 0 in if n < !lastval then arabic := !arabic - n else arabic := !arabic + n; lastval := n done; !arabic
let () =
Printf.printf " %d\n" (decimal_of_roman "MCMXC"); Printf.printf " %d\n" (decimal_of_roman "MMVIII"); Printf.printf " %d\n" (decimal_of_roman "MDCLXVI");
- </lang>
PARI/GP
<lang parigp>fromRoman(s)={
my(v=Vecsmall(s),key=vector(88),cur,t=0,tmp); key[73]=1;key[86]=5;key[88]=10;key[76]=50;key[67]=100;key[68]=500;key[77]=1000; cur=key[v[1]]; for(i=2,#v, tmp=key[v[i]]; if(!cur, cur=tmp; next); if(tmp>cur, t+=tmp-cur; cur=0 , t+=cur; cur=tmp ) ); t+cur
};</lang>
Perl
<lang Perl>use 5.10.0;
{
my @trans = ( [M => 1000], [CM => 900], [D => 500], [CD => 400], [C => 100], [XC => 90], [L => 50], [XL => 40], [X => 10], [IX => 9], [V => 5], [IV => 4], [I => 1], );
sub from_roman { my $r = shift; my $n = 0; foreach my $pair (@trans) { my ($k, $v) = @$pair; $n += $v while $r =~ s/^$k//i; } return $n }
}
say "$_: ", from_roman($_) for qw(MCMXC MDCLXVI MMVIII);</lang> Output:<lang>MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008</lang>
Perl 6
<lang perl6>sub rom-to-num($r) {
[+] gather $r.uc ~~ / ^ [ | 'M' { take 1000 } | 'CM' { take 900 } | 'D' { take 500 } | 'CD' { take 400 } | 'C' { take 100 } | 'XC' { take 90 } | 'L' { take 50 } | 'XL' { take 40 } | 'X' { take 10 } | 'IX' { take 9 } | 'V' { take 5 } | 'IV' { take 4 } | 'I' { take 1 } ]+ $ /;
}
say "$_ => &rom-to-num($_)" for <MCMXC MDCLXVI MMVIII>;</lang> Output:
MCMXC => 1990 MDCLXVI => 1666 MMVIII => 2008
PicoLisp
<lang PicoLisp>(de roman2decimal (Rom)
(let L (replace (chop Rom) 'M 1000 'D 500 'C 100 'L 50 'X 10 'V 5 'I 1) (sum '((A B) (if (>= A B) A (- A))) L (cdr L)) ) )</lang>
Test:
: (roman2decimal "MCMXC") -> 1990 : (roman2decimal "MMVIII") -> 2008 : (roman2decimal "MDCLXVI") -> 1666
Prolog
SWI-Prolog and clpfd
Works with SWI-Prolog and library clpfd.
Library clpfd assures that the program works in both managements : Roman towards Arabic and Arabic towards Roman.
It's 99% the same code !
<lang Prolog>roman :-
LA = [ _ , 2010, _, 1449, _],
LR = ['MDCCLXXXIX', _ , 'CX', _, 'MDCLXVI'],
maplist(roman, LA, LR),
% change here ! maplist(my_print,LR, LA).
roman(A, R) :-
A #> 0,
roman(A, [u, t, h, th], LR, []),
label([A]),
parse_Roman(CR, LR, []),
atom_chars(R, CR).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % using DCG
roman(0, []) --> [].
roman(N, [H | T]) --> {N1 #= N / 10, N2 #= N mod 10}, roman(N1, T), unity(N2, H).
unity(1, u) --> ['I']. unity(1, t) --> ['X']. unity(1, h) --> ['C']. unity(1, th)--> ['M'].
unity(4, u) --> ['IV']. unity(4, t) --> ['XL']. unity(4, h) --> ['CD']. unity(4, th)--> ['MMMM'].
unity(5, u) --> ['V']. unity(5, t) --> ['L']. unity(5, h) --> ['D']. unity(5, th)--> ['MMMMM'].
unity(9, u) --> ['IX']. unity(9, t) --> ['XC']. unity(9, h) --> ['CM']. unity(9, th)--> ['MMMMMMMMM'].
unity(0, _) --> [].
unity(V, U)-->
{V #> 5,
V1 #= V - 5},
unity(5, U),
unity(V1, U).
unity(V, U) --> {V #> 1, V #< 4, V1 #= V-1}, unity(1, U), unity(V1, U).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Extraction of roman "lexeme" parse_Roman(['C','M'|T]) --> ['CM'], parse_Roman(T).
parse_Roman(['C','D'|T]) --> ['CD'], parse_Roman(T).
parse_Roman(['X','C'| T]) --> ['XC'], parse_Roman(T).
parse_Roman(['X','L'| T]) -->
['XL'],
parse_Roman(T).
parse_Roman(['I','X'| T]) -->
['IX'],
parse_Roman(T).
parse_Roman(['I','V'| T]) -->
['IV'],
parse_Roman(T).
parse_Roman([H | T]) --> [H], parse_Roman(T).
parse_Roman([]) -->
[].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % change here ! my_print(A, R) :- format('~w in arabic is ~w~n', [A, R]). </lang> Output :
?- roman. MDCCLXXXIX in arabic is 1789 MMX in arabic is 2010 CX in arabic is 110 MCDXLIX in arabic is 1449 MDCLXVI in arabic is 1666 MCMXCIV in arabic is 1994 true
SWI Prolog
<lang prolog>char_to_num('M', 1000). char_to_num('D', 500). char_to_num('C', 100). char_to_num('L', 50). char_to_num('X', 10). char_to_num('V', 5). char_to_num('I', 1). char_to_num(_, 0).
unroman(, 0).
unroman(Roman, X) :- string_length(Roman, Length), RestLen is Length - 1, NextLen is Length - 2, sub_string(Roman, 1, 1, RestLen, First), sub_string(Roman, 2, 1, NextLen, Next), sub_string(Roman, 2, RestLen, 0, Rest), char_to_num(First, FirstNum), char_to_num(Next, NextNum), FirstNum >= NextNum, unroman(Rest, RestNum), X is RestNum + FirstNum.
unroman(Roman, X) :- string_length(Roman, Length), RestLen is Length - 1, NextLen is Length - 2, sub_string(Roman, 1, 1, RestLen, First), sub_string(Roman, 2, 1, NextLen, Next), sub_string(Roman, 2, RestLen, 0, Rest), char_to_num(First, FirstNum), char_to_num(Next, NextNum), FirstNum < NextNum, unroman(Rest, RestNum), X is RestNum - FirstNum.</lang>
PureBasic
<lang PureBasic>Procedure romanDec(roman.s)
Protected i, n, lastval, arabic For i = Len(roman) To 1 Step -1 Select UCase(Mid(roman, i, 1)) Case "M" n = 1000 Case "D" n = 500 Case "C" n = 100 Case "L" n = 50 Case "X" n = 10 Case "V" n = 5 Case "I" n = 1 Default n = 0 EndSelect If (n < lastval) arabic - n Else arabic + n EndIf lastval = n Next ProcedureReturn arabic
EndProcedure
If OpenConsole()
PrintN(Str(romanDec("MCMXCIX"))) ;1999 PrintN(Str(romanDec("MDCLXVI"))) ;1666 PrintN(Str(romanDec("XXV"))) ;25 PrintN(Str(romanDec("CMLIV"))) ;954 PrintN(Str(romanDec("MMXI"))) ;2011 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() CloseConsole()
EndIf</lang> Sample output:
1999 1666 25 954 2011
Python
<lang python>_rdecode = dict(zip('MDCLXVI', (1000, 500, 100, 50, 10, 5, 1)))
def decode( roman ):
result = 0 for r, r1 in zip(roman, roman[1:]): rd, rd1 = _rdecode[r], _rdecode[r1] result += -rd if rd < rd1 else rd return result + _rdecode[roman[-1]]
if __name__ == '__main__':
for r in 'MCMXC MMVIII MDCLXVI'.split(): print( r, decode(r) )</lang>
- Sample output
MCMXC 1990 MMVIII 2008 MDCLXVI 1666
Another version, for me clearer logic: <lang python>roman_values = (('I',1), ('IV',4), ('V',5), ('IX',9),('X',10),('XL',40),('L',50),('XC',90),('C',100),
('CD', 400), ('D', 500), ('CM', 900), ('M',1000))
def roman_value(roman):
total=0 for symbol,value in reversed(roman_values): while roman.startswith(symbol): total += value roman = roman[len(symbol):] return total
if __name__=='__main__':
for value in "MCMXC", "MMVIII", "MDCLXVI": print('%s = %i' % (value, roman_value(value)))
""" Output: MCMXC = 1990 MMVIII = 2008 MDCLXVI = 1666 """ </lang>--Tonyjv 16:29, 20 September 2011 (UTC)
REXX
<lang REXX>/* Rexx */
Do
/* 1990 2008 1666 */ years = 'MCMXC MMVIII MDCLXVI'
Do y_ = 1 to words(years) Say right(word(years, y_), 10) || ':' decode(word(years, y_)) End y_
Return
End Exit
decode:
Procedure
Do
Parse upper arg roman . If verify(roman, 'MDCLXVI') = 0 then Do
/* always insert the value of the least significant numeral */ decnum = rchar(substr(roman, length(roman), 1)) Do d_ = 1 to length(roman) - 1 If rchar(substr(roman, d_, 1)) < rchar(substr(roman, d_ + 1, 1)) then Do /* Handle cases where numerals are not in descending order */ /* subtract the value of the numeral */ decnum = decnum - rchar(substr(roman, d_, 1)) End else Do /* Normal case */ /* add the value of the numeral */ decnum = decnum + rchar(substr(roman, d_, 1)) End End d_ End else Do decnum = roman 'contains invalid roman numerals' End
Return decnum
End Exit
rchar:
Procedure
Do
Parse upper arg ch +1 .
select when ch = 'M' then digit = 1000 when ch = 'D' then digit = 500 when ch = 'C' then digit = 100 when ch = 'L' then digit = 50 when ch = 'X' then digit = 10 when ch = 'V' then digit = 5 when ch = 'I' then digit = 1 otherwise digit = 0 end
Return digit
End Exit </lang> Output:
MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666
Ruby
<lang ruby>def fromRoman(roman)
r = roman.dup.upcase n = 0 until r.empty? do case when r.start_with?('M') then v = 1000; len = 1 when r.start_with?('CM') then v = 900; len = 2 when r.start_with?('D') then v = 500; len = 1 when r.start_with?('CD') then v = 400; len = 2 when r.start_with?('C') then v = 100; len = 1 when r.start_with?('XC') then v = 90; len = 2 when r.start_with?('L') then v = 50; len = 1 when r.start_with?('XL') then v = 40; len = 2 when r.start_with?('X') then v = 10; len = 1 when r.start_with?('IX') then v = 9; len = 2 when r.start_with?('V') then v = 5; len = 1 when r.start_with?('IV') then v = 4; len = 2 when r.start_with?('I') then v = 1; len = 1 else raise ArgumentError.new("invalid roman numerals: " + roman) end n += v r[0 .. len-1] = "" end n
end
[ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| pp [r, fromRoman(r)]}</lang> outputs
["MCMXC", 1990] ["MMVIII", 2008] ["MDCLXVI", 1666]
Seed7
<lang seed7>$ include "seed7_05.s7i";
const func integer: ROMAN parse (in string: roman) is func
result var integer: arabic is 0; local var integer: index is 0; var integer: number is 0; var integer: lastval is 0; begin for index range length(roman) downto 1 do case roman[index] of when {'M', 'm'}: number := 1000; when {'D', 'd'}: number := 500; when {'C', 'c'}: number := 100; when {'L', 'l'}: number := 50; when {'X', 'x'}: number := 10; when {'V', 'v'}: number := 5; when {'I', 'i'}: number := 1; otherwise: raise RANGE_ERROR; end case; if number < lastval then arabic -:= number; else arabic +:= number; end if; lastval := number; end for; end func;
const proc: main is func
begin writeln(ROMAN parse "MCMXC"); writeln(ROMAN parse "MMVIII"); writeln(ROMAN parse "MDCLXVI"); end func;</lang>
Original source: [1]
Output:
1990 2008 1666
SNOBOL4
<lang SNOBOL4>* Roman to Arabic
define('arabic(n)s,ch,val,sum,x') :(arabic_end)
arabic s = 'M1000 D500 C100 L50 X10 V5 I1 '
n = reverse(n)
arab1 n len(1) . ch = :f(arab2)
s ch break(' ') . val val = lt(val,x) (-1 * val) sum = sum + val; x = val :(arab1)
arab2 arabic = sum :(return) arabic_end
- Test and display
tstr = 'MMX MCMXCIX MCDXCII MLXVI CDLXXVI "
tloop tstr break(' ') . r span(' ') = :f(out)
astr = astr r '=' arabic(r) ' ' :(tloop)
out output = astr end</lang>
Output:
MMX=2010 MCMXCIX=1999 MCDXCII=1492 MLXVI=1066 CDLXXVI=476
Here's an alternative version, which is maybe more SNOBOL4-idiomatic and less like one might program it in a more common language:
<lang SNOBOL4>* Roman to Arabic define("arabic1(romans,arabic1)rdigit,adigit,b4") romans1 = " 0 IX9 IV4 III3 II2 I1 VIII8 VII7 VI6 V5" :(arabic1_end) arabic1 ident(romans) :s(return) romans (break("IV") | rem) . b4 rem . rdigit = b4
romans1 " " rdigit any("0123456789") . adigit
arabic1 = adigit arabic1
romans = replace(romans,"MDCLX","CLXVI") :(arabic1)
arabic1_end
- Test and display
tstr = "MMX MCMXCIX MCDXCII MLXVI CDLXXVI "
tloop tstr break(' ') . r span(' ') = :f(out)
astr = astr r '=' arabic1(r) ' ' :(tloop)
out output = astr end</lang>
The output is the same as in the earlier version.
The following version takes advantage of some of the so-called "SPITBOL extensions", which are to be found in most modern implementations. This allows removing several labels and explicit transfers of control, and moves some of the looping into the pattern matcher. Again, the output is the same.
<lang SNOBOL4>* Roman to Arabic define("arabic1(romans,arabic1)rdigit,adigit,b4") romans1 = " 0 IX9 IV4 III3 II2 I1 VIII8 VII7 VI6 V5" :(arabic1_end) arabic1 ident(romans) :s(return) romans (break("IV") | rem) . b4 rem . rdigit = replace(b4,"MDCLX","CLXVI")
romans1 " " rdigit any("0123456789") . adigit
arabic1 = adigit arabic1 :(arabic1) arabic1_end
- Test and display
tstr = " MMX MCMXCIX MCDXCII MLXVI CDLXXVI " tstr span(' ') break(' ') $ r *?(astr = astr r '=' arabic1(r) ' ') fail output = astr
end</lang>
Tcl
As long as we assume that we have a valid roman number, this is most easily done by transforming the number into a sum and evaluating the expression: <lang tcl>proc fromRoman rnum {
set map {M 1000+ CM 900+ D 500+ CD 400+ C 100+ XC 90+ L 50+ XL 40+ X 10+ IX 9+ V 5+ IV 4+ I 1+} expr [string map $map $rnum]0}
}</lang> Demonstrating: <lang tcl>foreach r {MCMXC MDCLXVI MMVIII} {
puts "$r\t-> [fromRoman $r]"
}</lang> Output:
MCMXC -> 1990 MDCLXVI -> 1666 MMVIII -> 2008
TUSCRIPT
<lang tuscript> $$ MODE TUSCRIPT LOOP roman_number="MCMXC'MMVIII'MDCLXVI" arab_number=DECODE (roman_number,ROMAN) PRINT "Roman number ",roman_number," equals ", arab_number ENDLOOP </lang> Output:
Roman number MCMXC equals 1990 Roman number MMVIII equals 2008 Roman number MDCLXVI equals 1666
Vedit macro language
<lang vedit>// Main program for testing the function // do {
Get_Input(10, "Enter a roman numeral: ", NOCR+STATLINE) Call("Roman_to_Arabic") Reg_Type(10) Message(" = ") Num_Type(#1)
} while(#1) Return
// Convert Roman numeral into numeric value // in: @10 = Roman numeral // out: #1 = numeric value //
- Roman_to_Arabic:
Buf_Switch(Buf_Free) Ins_Text("M1000 D500 C100 L50 X10 V5 I1") Ins_Newline Reg_Ins(10) Ins_Char(' ') #1 = #2 = 0
Repeat(ALL) { #3 = #2 // #3 = previous character Goto_Line(2) // roman numeral to be converted if (At_EOL) { Break // all done } Reg_Copy_Block(11, CP, CP+1, DELETE) // next character in roman numeral if (Search(@11, BEGIN+ADVANCE+NOERR)) { // find character from the table #2 = Num_Eval(SUPPRESS) // corresponding numeric value if (#2 > #3) { // larger than previous digit? #1 -= #3 // substract previous digit } else { #1 += #3 // add previous digit } } } Reg_Empty(11) Buf_Quit(OK)
Return</lang>
Sample output:
iv = 4 xii = 12 MDCLXVI = 1666 MCMXC = 1990 MMXI = 2011
Zsh
<lang zsh>function parseroman () {
local max=0 sum i j local -A conv conv=(I 1 V 5 X 10 L 50 C 100 D 500 M 1000) for j in ${(Oas::)1}; do i=conv[$j] if (( i >= max )); then (( sum+=i )) (( max=i )) else (( sum-=i )) fi done echo $sum
}</lang>
- Programming Tasks
- Solutions by Programming Task
- Ada
- C
- C++
- Common Lisp
- D
- Delphi
- Euphoria
- Fortran
- Go
- Groovy
- Haskell
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- JavaScript
- K
- Logo
- Lua
- NetRexx
- OCaml
- PARI/GP
- Perl
- Perl 6
- PicoLisp
- Prolog
- Prolog examples needing attention
- Examples needing attention
- PureBasic
- Python
- REXX
- Ruby
- Seed7
- SNOBOL4
- Tcl
- TUSCRIPT
- Vedit macro language
- Zsh
- GUISS/Omit