⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{task}}

;Task: 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 decimal digit and skipping any '''0'''s (zeroes).

'''1990''' is rendered as '''MCMXC''' (1000 = M, 900 = CM, 90 = XC) and

'''2008''' is rendered as '''MMVIII''' (2000 = MM, 8 = VIII).

The Roman numeral for '''1666''', '''MDCLXVI''', uses each letter in descending order.

360 Assembly

*        Roman numerals Decode -   17/04/2019
ROMADEC  CSECT
         USING  ROMADEC,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=A(NV))   do i=1 to hbound(vals)
         LR     R1,R6                i
         SLA    R1,3                 ~
         LA     R4,VALS-L'VALS(R1)   @vals(i)
         MVC    X,0(R4)              x=vals(i)
         SR     R9,R9                prev=0
         ST     R9,Y                 y=0
         LA     R7,L'X               j=1
       DO WHILE=(C,R7,GE,=A(1))      do j=length(x) to 1 by -1
         LA     R4,X-1                 @x
         AR     R4,R7                  +j
         MVC    C,0(R4)                c=substr(x,j,1)
       IF   CLI,C,NE,C' ' THEN         if c^=' ' then
         SR     R1,R1                  r1=0
         LA     R2,1                   k=1
       DO WHILE=(C,R2,LE,=A(L'ROMAN))   do k=1 to length(roman)
         LA     R3,ROMAN-1               @roman
         AR     R3,R2                    +k
       IF   CLC,0(L'C,R3),EQ,C THEN      if substr(roman,k,1)=c
         LR     R1,R2                      index=k
         B      REINDEX                    leave k
       ENDIF    ,                        endif
         LA     R2,1(R2)                 k=k+1
       ENDDO    ,                      enddo k
REINDEX  EQU    *                      r1=index(roman,c)
         SLA    R1,2                   ~
         L      R8,DECIM-4(R1)         n=decim(index(roman,c))
       IF    CR,R8,LT,R9 THEN          if n<prev then
         LCR    R8,R8                    n=-n
       ENDIF    ,                      endif
         L      R2,Y                     y
         AR     R2,R8                    +n
         ST     R2,Y                     y=y+n
         LR     R9,R8                    prev=n
       ENDIF    ,                      endif
         BCTR   R7,0                   j--
       ENDDO    ,                    enddo j
         MVC    PG(8),X              x
         L      R1,Y                 y
         XDECO  R1,XDEC              edit y
         MVC    PG+12(4),XDEC+8      output y
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
NV       EQU    (X-VALS)/L'VALS
ROMAN    DC     CL7'MDCLXVI'
DECIM    DC     F'1000',F'500',F'100',F'50',F'10',F'5',F'1'
VALS     DC     CL8'XIV',CL8'CMI',CL8'MIC',CL8'MCMXC',CL8'MDCLXVI'
         DC     CL8'MMVIII',CL8'MMXIX',CL8'MMMCMXCV'
X        DS     CL(L'VALS)
Y        DS     F
C        DS     CL1
PG       DC     CL80'........ -> ....'
XDEC     DS     CL12
         REGEQU
         END    ROMADEC

{{out}}


XIV      ->   14
CMI      ->  901
MIC      -> 1099
MCMXC    -> 1990
MDCLXVI  -> 1666
MMVIII   -> 2008
MMXIX    -> 2019
MMMCMXCV -> 3995

Ada

Pragma Ada_2012;
Pragma Assertion_Policy( Check );

With
Unchecked_Conversion,
Ada.Text_IO;

Procedure Test_Roman_Numerals is

    -- We create an enumeration of valid characters, note that they are
    -- character-literals, this is so that we can use literal-strings,
    -- and that their size is that of Integer.
    Type Roman_Digits is ('I', 'V', 'X', 'L', 'C', 'D', 'M' )
    with Size => Integer'Size;

    -- We use a representation-clause ensure the proper integral-value
    -- of each individual character.
    For Roman_Digits use
      (
    'I' => 1,
    'V' => 5,
    'X' => 10,
    'L' => 50,
    'C' => 100,
    'D' => 500,
    'M' => 1000
      );

    -- To convert a Roman_Digit to an integer, we now only need to
    -- read its value as an integer.
    Function Convert is new Unchecked_Conversion
      (	Source => Roman_Digits,	Target => Integer );

    -- Romena_Numeral is a string of Roman_Digit.
    Type Roman_Numeral is array (Positive range <>) of Roman_Digits;

    -- The Numeral_List type is used herein only for testing
    -- and verification-data.
    Type Numeral_List is array (Positive range <>) of
      not null access Roman_Numeral;

    -- The Test_Cases subtype ensures that Test_Data and Validation_Data
    -- both contain the same number of elements, and that the indecies
    -- are the same; essentially the same as:
    --
    --    pragma Assert( Test_Data'Length = Validation_Data'Length
    --		   AND Test_Data'First = Validation_Data'First);

    subtype Test_Cases is Positive range 1..14;

    Test_Data : constant Numeral_List(Test_Cases):=
      (
       New Roman_Numeral'("III"),	-- 3
       New Roman_Numeral'("XXX"),	-- 30
       New Roman_Numeral'("CCC"),	-- 300
       New Roman_Numeral'("MMM"),	-- 3000

       New Roman_Numeral'("VII"),	-- 7
       New Roman_Numeral'("LXVI"),	-- 66
       New Roman_Numeral'("CL"),	-- 150
       New Roman_Numeral'("MCC"),	-- 1200

       New Roman_Numeral'("IV"),	-- 4
       New Roman_Numeral'("IX"),	-- 9
       New Roman_Numeral'("XC"),	-- 90

       New Roman_Numeral'("ICM"),	-- 901
       New Roman_Numeral'("CIM"),	-- 899

       New Roman_Numeral'("MDCLXVI")	-- 1666
      );

    Validation_Data : constant array(Test_Cases) of Natural:=
      (	3, 30, 300, 3000,
	7, 66, 150, 1200,
	4, 9, 90,
	901, 899,
	1666
      );


    -- In Roman numerals, the subtractive form [IV = 4] was used
    -- very infrequently, the most common form was the addidive
    -- form [IV = 6]. (Consider military logistics and squads.)

    -- SUM returns the Number, read in the additive form.
    Function Sum( Number : Roman_Numeral ) return Natural is
    begin
	Return Result : Natural:= 0 do
	    For Item of Number loop
		    Result:= Result + Convert( Item );
	    end loop;
	End Return;
    end Sum;

    -- EVAL returns Number read in the subtractive form.
    Function Eval( Number : Roman_Numeral ) return Natural is
	Current : Roman_Digits:= 'I';
    begin
	Return Result : Natural:= 0 do
	    For Item of Number loop
		if Current < Item then
		    Result:= Convert(Item) - Result;
		    Current:= Item;
		else
		    Result:= Result + Convert(Item);
		end if;
	    end loop;
	End Return;
    end Eval;

    -- Display the given Roman_Numeral via Text_IO.
    Procedure Put( S: Roman_Numeral ) is
    begin
	For Ch of S loop
	    declare
		-- The 'Image attribute returns the character inside
		-- single-quotes; so we select the character itself.
		C : Character renames Roman_Digits'Image(Ch)(2);
	    begin
		Ada.Text_IO.Put( C );
	    end;
	end loop;
    end;

    -- This displays pass/fail dependant on the parameter.
    Function PF ( Value : Boolean ) Return String is
    begin
	Return Result : String(1..4):= ( if Value then"pass"else"fail" );
    End PF;

Begin
    Ada.Text_IO.Put_Line("Starting Test:");

    for Index in Test_Data'Range loop
	declare
	    Item  : Roman_Numeral renames Test_Data(Index).all;
	    Value : constant Natural := Eval(Item);
	begin
	    Put( Item );

	    Ada.Text_IO.Put( ASCII.HT & "= ");
	    Ada.Text_IO.Put( Value'Img );
	    Ada.Text_IO.Put_Line( ASCII.HT & '[' &
			  PF( Value = Validation_Data(Index) )& ']');
	end;
    end loop;


    Ada.Text_IO.Put_Line("Testing complete.");
End Test_Roman_Numerals;

{{out}}

Starting Test:
III	=  3	[pass]
XXX	=  30	[pass]
CCC	=  300	[pass]
MMM	=  3000	[pass]
VII	=  7	[pass]
LXVI	=  66	[pass]
CL	=  150	[pass]
MCC	=  1200	[pass]
IV	=  4	[pass]
IX	=  9	[pass]
XC	=  90	[pass]
ICM	=  901	[pass]
CIM	=  899	[pass]
MDCLXVI	=  1666	[pass]
Testing complete.

ALGOL 68

{{works with|ALGOL 68G|Any - tested with release 2.2.0}} Note: roman to int will handle multiple subtraction, e.g. IIIIX for 6.

    PROC roman to int = (STRING roman) INT:
    BEGIN
        PROC roman digit value = (CHAR roman digit) INT:
            (roman digit = "M" | 1000 |:
             roman digit = "D" |  500 |:
             roman digit = "C" |  100 |:
             roman digit = "L" |   50 |:
             roman digit = "X" |   10 |:
             roman digit = "V" |    5 |:
             roman digit = "I" |    1);

        INT result := 0, previous value := 0, run := 0;

        FOR i FROM LWB roman TO UPB roman
        DO
            INT value = roman digit value(roman[i]);
            IF previous value = value THEN
                run +:= value
            ELSE
                IF previous value < value THEN
                    result -:= run
                ELSE
                    result +:= run
                FI;
                run := previous value := value
            FI
        OD;

        result +:= run
    END;

    MODE TEST = STRUCT (STRING input, INT expected output);

    [] TEST roman test = (
        ("MMXI",    2011), ("MIM",     1999),
        ("MCMLVI",  1956), ("MDCLXVI", 1666),
        ("XXCIII",    83), ("LXXIIX",    78),
        ("IIIIX",      6)
    );

    print(("Test input  Value   Got", newline, "--------------------------", newline));
    FOR i FROM LWB roman test TO UPB roman test
    DO
        INT output = roman to int(input OF roman test[i]);
        printf(($g, n (12 - UPB input OF roman test[i]) x$, input OF roman test[i]));
        printf(($g(5), 1x, g(5), 1x$, expected output OF roman test[i], output));
        printf(($b("ok", "not ok"), 1l$, output = expected output OF roman test[i]))
    OD

ALGOL W

begin
    % decodes a roman numeral into an integer                                %
    % there must be at least one blank after the numeral                     %
    % This takes a lenient view on roman numbers so e.g. IIXX is 18 - see    %
    % the Discussion                                                         %
    integer procedure romanToDecimal ( string(32) value roman ) ;
    begin
        integer   decimal, rPos, currDigit, nextDigit, seqValue;
        string(1) rDigit;

        % the roman number is a sequence of sequences of roman digits        %
        % if the previous sequence is of higher value digits than the next,  %
        %    the higher value is added to the overall value                  %
        % if the previous seequence is of lower value, it is subtracted      %
        % e.g. MCMLXII                                                       %
        %      the sequences are M, C, M, X, II                              %
        %          M is added, C subtracted, M added, X added and II added   %

        % get the value of a sequence of roman digits                        %
        integer procedure getSequence ;
            if rDigit = " " then begin
                % end of the number                                          %
                0
                end
            else begin
                % have another sequence                                      %
                integer sValue;
                sValue := 0;
                while roman( rPos // 1 ) = rDigit do begin
                    sValue := sValue + currDigit;
                    rPos   := rPos + 1;
                end while_have_same_digit ;
                % remember the next digit                                    %
                rDigit     := roman( rPos // 1 );
                % result is the sequence value                               %
                sValue
             end getSequence ;

        % convert a roman digit into its decimal equivalent                  %
        % an invalid digit will terminate the program, " " is 0              %
        integer procedure getValue( string(1) value romanDigit ) ;
            if      romanDigit = "m" or romanDigit = "M" then 1000
            else if romanDigit = "d" or romanDigit = "D" then  500
            else if romanDigit = "c" or romanDigit = "C" then  100
            else if romanDigit = "l" or romanDigit = "L" then   50
            else if romanDigit = "x" or romanDigit = "X" then   10
            else if romanDigit = "v" or romanDigit = "V" then    5
            else if romanDigit = "i" or romanDigit = "I" then    1
            else if romanDigit = " "                     then    0
            else begin
                write( s_w := 0, "Invalid roman digit: """, romanDigit, """" );
                assert false;
                0
            end getValue ;

        % get the first sequence                                             %
        decimal   := 0;
        rPos      := 0;
        rDigit    := roman( rPos // 1 );
        currDigit := getValue( rDigit );
        seqValue  := getSequence;

        % handle the sequences                                               %
        while rDigit not = " " do begin
            % have another sequence                                          %
            nextDigit := getValue( rDigit );
            if currDigit < nextDigit
            then % prev digit is lower  % decimal := decimal - seqValue
            else % prev digit is higher % decimal := decimal + seqValue
            ;
            currDigit := nextDigit;
            seqValue  := getSequence;
        end while_have_a_roman_digit ;

        % add the final sequence                                             %
        decimal + seqValue
    end roman ;

    % test the romanToDecimal routine                                        %

    procedure testRoman ( string(32) value romanNumber ) ;
        write( i_w := 5, romanNumber, romanToDecimal( romanNumber ) );

    testRoman( "I"        );    testRoman( "II"       );
    testRoman( "III"      );    testRoman( "IV"       );
    testRoman( "V"        );    testRoman( "VI"       );
    testRoman( "VII"      );    testRoman( "VIII"     );
    testRoman( "IX"       );    testRoman( "IIXX"     );
    testRoman( "XIX"      );    testRoman( "XX"       );
    write( "..." );
    testRoman( "MCMXC"    );
    testRoman( "MMVIII"   );
    testRoman( "MDCLXVI"  );

end.

{{out}}


I                                   1
II                                  2
III                                 3
IV                                  4
V                                   5
VI                                  6
VII                                 7
VIII                                8
IX                                  9
IIXX                               18
XIX                                19
XX                                 20
...
MCMXC                            1990
MMVIII                           2008
MDCLXVI                          1666

ANTLR

[[File:Rn.PNG|left|Roman Numeral]] [[File:Hundreds.PNG|left|Roman Numeral]] [[File:H5.PNG|left|Roman Numeral]] [[File:H9.PNG|left|Roman Numeral]] [[File:Tens.PNG|left|Roman Numeral]] [[File:T5.PNG|left|Roman Numeral]] [[File:T9.PNG|left|Roman Numeral]] [[File:Units.PNG|left|Roman Numeral]] [[File:U5.PNG|left|Roman Numeral]] [[File:U9.PNG|left|Roman Numeral]]

Java

/* Parse Roman Numerals

   Nigel Galloway March 16th., 2012
*/
grammar ParseRN ;

options {
	language = Java;
}
@members {
int rnValue;
int ONE;
}

parseRN:	({rnValue = 0;} rn NEWLINE {System.out.println($rn.text + " = " + rnValue);})*
	;

rn	:	(Thousand {rnValue += 1000;})* hundreds? tens? units?;

hundreds:	{ONE = 0;} (h9 | h5) {if (ONE > 3) System.out.println ("Too many hundreds");};
h9	:	Hundred {ONE += 1;} (FiveHund {rnValue += 400;}| Thousand {rnValue += 900;}|{rnValue += 100;} (Hundred {rnValue += 100; ONE += 1;})*);
h5	:	FiveHund {rnValue += 500;} (Hundred {rnValue += 100; ONE += 1;})*;

tens	:	{ONE = 0;} (t9 | t5) {if (ONE > 3) System.out.println ("Too many tens");};
t9	:	Ten {ONE += 1;} (Fifty {rnValue += 40;}| Hundred {rnValue += 90;}|{rnValue += 10;} (Ten {rnValue += 10; ONE += 1;})*);
t5	:	Fifty {rnValue += 50;} (Ten {rnValue += 10; ONE += 1;})*;

units	:	{ONE = 0;} (u9 | u5) {if (ONE > 3) System.out.println ("Too many ones");};
u9	:	One {ONE += 1;} (Five {rnValue += 4;}| Ten {rnValue += 9;}|{rnValue += 1;} (One {rnValue += 1; ONE += 1;})*);
u5	:	Five {rnValue += 5;} (One {rnValue += 1; ONE += 1;})*;

One	:	'I';
Five	:	'V';
Ten	:	'X';
Fifty	:	'L';
Hundred:	'C';
FiveHund:	'D';
Thousand:	'M' ;
NEWLINE:	'\r'? '\n' ;

Using this test data:


MMXI
MCMLVI
XXCIII
MCMXC
MMVIII
MDCLXVI
IIIIX
MIM
MDCLXVI
LXXIIX
M
MCXI
CMXI
MCM
MMIX
MCDXLIV
MMXII

Produces:


MMXI = 2011
MCMLVI = 1956
line 3:2 missing NEWLINE at 'C'
XX = 20
CIII = 103

Note that this implementation does not accept XXC as eighty. The error is detected and ANTLR attempts to continue by inserting the expected NEWLINE after XX and treating CIII as a new Number.


MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
Too many ones
line 7:4 extraneous input 'X' expecting NEWLINE
IIII = 4

An implementation above thinks IIIIX is 6. It isn't. ANTLR detects the surfiet of 'I' reports the errors and tries to carry on.


line 8:2 no viable alternative at input 'M'
MIM = 1000
MDCLXVI = 1666
line 10:5 extraneous input 'X' expecting NEWLINE
LXXII = 72
M = 1000
MCXI = 1111
CMXI = 911
MCM = 1900
MMIX = 2009
MCDXLIV = 1444
MMXII = 2012

AppleScript

=isPrefixOf=

{{trans|JavaScript}} (Functional ES5 version) {{trans|Haskell}}

-- romanValue :: String -> Int
on romanValue(s)
    script roman
        property 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]]

        -- Value of first Roman glyph + value of remaining glyphs
        -- toArabic :: [Char] -> Int
        on toArabic(xs)
            script transcribe
                -- If this glyph:value pair matches the head of the list
                -- return the value and the tail of the list
                -- transcribe :: (String, Number) -> Maybe (Number, [String])
                on |λ|(lstPair)
                    set lstR to characters of (item 1 of lstPair)
                    if isPrefixOf(lstR, xs) then
                        -- Value of this matching glyph, with any remaining glyphs
                        {item 2 of lstPair, drop(length of lstR, xs)}
                    else
                        {}
                    end if
                end |λ|
            end script

            if length of xs > 0 then
                set lstParse to concatMap(transcribe, mapping)
                (item 1 of lstParse) + toArabic(item 2 of lstParse)
            else
                0
            end if
        end toArabic
    end script

    toArabic(characters of s) of roman
end romanValue

-- TEST -----------------------------------------------------------------------
on run
    map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})

    --> {1990, 1666, 2008}
end run


-- GENERIC FUNCTIONS ----------------------------------------------------------

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lst to {}
    set lng to length of xs
    tell mReturn(f)
        repeat with i from 1 to lng
            set lst to (lst & |λ|(item i of xs, i, xs))
        end repeat
    end tell
    return lst
end concatMap

--  drop :: Int -> a -> a
on drop(n, a)
    if n < length of a then
        if class of a is text then
            text (n + 1) thru -1 of a
        else
            items (n + 1) thru -1 of a
        end if
    else
        {}
    end if
end drop

-- isPrefixOf :: [a] -> [a] -> Bool
on isPrefixOf(xs, ys)
    if length of xs = 0 then
        true
    else
        if length of ys = 0 then
            false
        else
            set {x, xt} to uncons(xs)
            set {y, yt} to uncons(ys)
            (x = y) and isPrefixOf(xt, yt)
        end if
    end if
end isPrefixOf

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
    if length of xs > 0 then
        {item 1 of xs, rest of xs}
    else
        missing value
    end if
end uncons

{{Out}}

{1990, 1666, 2008}

====Fold right – subtracting or adding==== {{Works with|Yosemite onwards}} {{trans|Haskell}}

use framework "Foundation"

-- INTEGER VALUE OF ROMAN NUMBER STRING ---------------------------------------

-- fromRoman :: String -> Int
on fromRoman(s)
    script subtractIfLower
        on |λ|(rn, L)
            set {r, n} to rn
            if L  r then  -- Digit values that increase (right to left),
                {L, n + L} -- are added
            else
                {L, n - L} -- Digit values that go down, are subtracted.
            end if
        end |λ|
    end script

    snd(foldr(subtractIfLower, {0, 0}, map(my charVal, characters of s)))
end fromRoman

-- charVal :: Char -> Int
on charVal(C)
    set V to keyValue({I:1, V:5, X:10, L:50, C:100, D:500, M:1000}, ¬
        toUpper(C))
    if nothing of V then
        0
    else
        just of V
    end if
end charVal

-- TEST -----------------------------------------------------------------------
on run
    map(fromRoman, {"MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"})

    --> {1666, 1990, 2008, 2016, 2017}
end run


-- GENERIC FUNCTIONS ----------------------------------------------------------

-- foldr :: (a -> b -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
    tell mReturn(f)
        set V to startValue
        set lng to length of xs
        repeat with I from lng to 1 by -1
            set V to |λ|(V, item I of xs, I, xs)
        end repeat
        return V
    end tell
end foldr

-- keyValue :: Record -> String -> Maybe String
on keyValue(rec, strKey)
    set ca to current application
    set V to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey
    if V is not missing value then
        {nothing:false, just:item 1 of ((ca's NSArray's arrayWithObject:V) as list)}
    else
        {nothing:true}
    end if
end keyValue

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with I from 1 to lng
            set end of lst to |λ|(item I of xs, I, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- snd :: (a, b) -> b
on snd(xs)
    if class of xs is list and length of xs = 2 then
        item 2 of xs
    else
        missing value
    end if
end snd

-- toUpper :: String -> String
on toUpper(str)
    set ca to current application
    ((ca's NSString's stringWithString:(str))'s ¬
        uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text
end toUpper

{{Out}}

{1666, 1990, 2008, 2016, 2017}

AutoHotkey

{{works with|AutoHotkey_L}}

Roman_Decode(str){
	res := 0
	Loop Parse, str
	{
		n := {M: 1000, D:500, C:100, L:50, X:10, V:5, I:1}[A_LoopField]
		If ( n > OldN ) && OldN
			res -= 2*OldN
		res += n, oldN := n
	}
	return res
}

test = MCMXC|MMVIII|MDCLXVI
Loop Parse, test, |
   res .= A_LoopField "`t= " Roman_Decode(A_LoopField) "`r`n"
clipboard := res

{{out}}

MCMXC	= 1990
MMVIII	= 2008
MDCLXVI	= 1666

AWK

# syntax: GAWK -f ROMAN_NUMERALS_DECODE.AWK
BEGIN {
    leng = split("MCMXC MMVIII MDCLXVI",arr," ")
    for (i=1; i<=leng; i++) {
      n = arr[i]
      printf("%s = %s\n",n,roman2arabic(n))
    }
    exit(0)
}
function roman2arabic(r,  a,i,p,q,u,ua,una,unr) {
    r = toupper(r)
    unr = "MDCLXVI" # each Roman numeral in descending order
    una = "1000 500 100 50 10 5 1" # and its Arabic equivalent
    split(una,ua," ")
    i = split(r,u,"")
    a = ua[index(unr,u[i])]
    while (--i) {
      p = index(unr,u[i])
      q = index(unr,u[i+1])
      a += ua[p] * ((p>q) ? -1 : 1)
    }
    return( (a>0) ? a : "" )
}

{{out}}


MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666

BBC BASIC

      PRINT "MCMXCIX", FNromandecode("MCMXCIX")
      PRINT "MMXII", FNromandecode("MMXII")
      PRINT "MDCLXVI", FNromandecode("MDCLXVI")
      PRINT "MMMDCCCLXXXVIII", FNromandecode("MMMDCCCLXXXVIII")
      END

      DEF FNromandecode(roman$)
      LOCAL i%, j%, p%, n%, r%()
      DIM r%(7) : r%() = 0,1,5,10,50,100,500,1000
      FOR i% = LEN(roman$) TO 1 STEP -1
        j% = INSTR("IVXLCDM", MID$(roman$,i%,1))
        IF j%=0 ERROR 100, "Invalid character"
        IF j%>=p% n% += r%(j%) ELSE n% -= r%(j%)
        p% = j%
      NEXT
      = n%

{{out}}


MCMXCIX         1999
MMXII           2012
MDCLXVI         1666
MMMDCCCLXXXVIII           3888

Batch File

{{trans|Fortran}}

@echo off
setlocal enabledelayedexpansion

::Testing...
call :toArabic MCMXC
echo MCMXC = !arabic!
call :toArabic MMVIII
echo MMVIII = !arabic!
call :toArabic MDCLXVI
echo MDCLXVI = !arabic!
call :toArabic CDXLIV
echo CDXLIV = !arabic!
call :toArabic XCIX
echo XCIX = !arabic!
pause>nul
exit/b 0

::The "function"...
:toArabic
set roman=%1
set arabic=
set lastval=
	%== Alternative for counting the string length ==%
set leng=-1
for /l %%. in (0,1,1000) do set/a leng+=1&if "!roman:~%%.,1!"=="" goto break
:break
set /a last=!leng!-1
for /l %%i in (!last!,-1,0) do (
	set n=0
	if /i "!roman:~%%i,1!"=="M" set n=1000
	if /i "!roman:~%%i,1!"=="D" set n=500
	if /i "!roman:~%%i,1!"=="C" set n=100
	if /i "!roman:~%%i,1!"=="L" set n=50
	if /i "!roman:~%%i,1!"=="X" set n=10
	if /i "!roman:~%%i,1!"=="V" set n=5
	if /i "!roman:~%%i,1!"=="I" set n=1

	if !n! lss !lastval! (
		set /a arabic-=n
	) else (
		set /a arabic+=n
	)
	set lastval=!n!
)
goto :EOF

{{Out}}

MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
CDXLIV = 444
XCIX = 99

Bracmat

{{trans|Icon and Unicon}}

  ( unroman
  =   nbr,lastVal,val
    .     0:?nbr:?lastVal
        & @( low$!arg
           :   ?
               %@?L
               ( ?
               &     (m.1000)
                     (d.500)
                     (c.100)
                     (l.50)
                     (x.10)
                     (v.5)
                     (i.1)
                 : ? (!L.?val) ?
               &     (!val:~>!lastVal|!val+-2*!lastVal)
                   + !nbr
                 : ?nbr
               & !val:?lastVal
               & ~
               )
           )
      | !nbr
  )
&     (M.1000)
      (MCXI.1111)
      (CMXI.911)
      (MCM.1900)
      (MCMXC.1990)
      (MMVIII.2008)
      (MMIX.2009)
      (MCDXLIV.1444)
      (MDCLXVI.1666)
      (MMXII.2012)
  : ?years
& (test=.out$(!arg unroman$!arg))
& (   !years
    : ? (?L.?D) (?&test$!L&~)
  | done
  );

{{out}}

M 1000
MCXI 1111
CMXI 911
MCM 1900
MCMXC 1990
MMVIII 2008
MMIX 2009
MCDXLIV 1444
MDCLXVI 1666
MMXII 2012

C

Note: the code deliberately did not distinguish between "I", "J" or "U", "V", doing what Romans did for fun.

#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(const char * roman)
{
        const 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()
{
        const 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;
}

C++


#include <exception>
#include <string>
#include <iostream>
using namespace std;

namespace Roman
{
	int ToInt(char c)
	{
		switch (c)
		{
			case 'I':  return 1;
			case 'V':  return 5;
			case 'X':  return 10;
			case 'L':  return 50;
			case 'C':  return 100;
			case 'D':  return 500;
			case 'M':  return 1000;
		}
		throw exception("Invalid character");
	}

	int ToInt(const string& s)
	{
		int retval = 0, pvs = 0;
		for (auto pc = s.rbegin(); pc != s.rend(); ++pc)
		{
			const int inc = ToInt(*pc);
			retval += inc < pvs ? -inc : inc;
			pvs = inc;
		}
		return retval;
	}
}

int main(int argc, char* argv[])
{
	try
	{
		cout << "MCMXC = " << Roman::ToInt("MCMXC") << "\n";
		cout << "MMVIII = " << Roman::ToInt("MMVIII") << "\n";
		cout << "MDCLXVI = " << Roman::ToInt("MDCLXVI") << "\n";
	}
	catch (exception& e)
	{
		cerr << e.what();
		return -1;
	}
	return 0;
}

{{out}}

MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
## C# ```c# using System; using System.Collections.Generic; namespace Roman { internal class Program { private static void Main(string[] args) { // Decode and print the numerals. Console.WriteLine("{0}: {1}", "MCMXC", Decode("MCMXC")); Console.WriteLine("{0}: {1}", "MMVIII", Decode("MMVIII")); Console.WriteLine("{0}: {1}", "MDCLXVI", Decode("MDCLXVI")); } // Dictionary to hold our numerals and their values. private static readonly Dictionary RomanDictionary = new Dictionary { {'I', 1}, {'V', 5}, {'X', 10}, {'L', 50}, {'C', 100}, {'D', 500}, {'M', 1000} }; private static int Decode(string roman) { /* Make the input string upper-case, * because the dictionary doesn't support lower-case characters. */ roman = roman.ToUpper(); /* total = the current total value that will be returned. * minus = value to subtract from next numeral. */ int total = 0, minus = 0; for (int i = 0; i < roman.Length; i++) // Iterate through characters. { // Get the value for the current numeral. Takes subtraction into account. int thisNumeral = RomanDictionary[roman[i]] - minus; /* Checks if this is the last character in the string, or if the current numeral * is greater than or equal to the next numeral. If so, we will reset our minus * variable and add the current numeral to the total value. Otherwise, we will * subtract the current numeral from the next numeral, and continue. */ if (i >= roman.Length - 1 || thisNumeral + minus >= RomanDictionary[roman[i + 1]]) { total += thisNumeral; minus = 0; } else { minus = thisNumeral; } } return total; // Return the total. } } } ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 ``` ## Ceylon ```ceylon shared void run() { value numerals = map { 'I' -> 1, 'V' -> 5, 'X' -> 10, 'L' -> 50, 'C' -> 100, 'D' -> 500, 'M' -> 1000 }; function toHindu(String roman) { variable value total = 0; for(i->c in roman.indexed) { assert(exists currentValue = numerals[c]); /* Look at the next letter to see if we're looking at a IV or CM or whatever. If so subtract the current number from the total. */ if(exists next = roman[i + 1], exists nextValue = numerals[next], currentValue < nextValue) { total -= currentValue; } else { total += currentValue; } } return total; } assert(toHindu("I") == 1); assert(toHindu("II") == 2); assert(toHindu("IV") == 4); assert(toHindu("MDCLXVI") == 1666); assert(toHindu("MCMXC") == 1990); assert(toHindu("MMVIII") == 2008); } ``` ## Clojure ```clojure ;; Incorporated some improvements from the alternative implementation below (defn ro2ar [r] (->> (reverse (.toUpperCase r)) (map {\M 1000 \D 500 \C 100 \L 50 \X 10 \V 5 \I 1}) (partition-by identity) (map (partial apply +)) (reduce #(if (< %1 %2) (+ %1 %2) (- %1 %2))))) ;; alternative (def numerals { \I 1, \V 5, \X 10, \L 50, \C 100, \D 500, \M 1000}) (defn from-roman [s] (->> s .toUpperCase (map numerals) (reduce (fn [[sum lastv] curr] [(+ sum curr (if (< lastv curr) (* -2 lastv) 0)) curr]) [0,0]) first)) ``` {{out}} ```txt (map ro2ar ["MDCLXVI" "MMMCMXCIX" "XLVIII" "MMVIII"]) (1666 3999 48 2008) ``` ## COBOL ```COBOL IDENTIFICATION DIVISION. PROGRAM-ID. UNROMAN. DATA DIVISION. WORKING-STORAGE SECTION. 01 filler. 03 i pic 9(02) comp. 03 j pic 9(02) comp. 03 k pic 9(02) comp. 03 l pic 9(02) comp. 01 inp-roman. 03 inp-rom-ch pic x(01) occurs 20 times. 01 inp-roman-digits. 03 inp-rom-digit pic 9(01) occurs 20 times. 01 ws-search-idx pic 9(02) comp. 01 ws-tbl-table-def. 03 filler pic x(05) value '1000M'. 03 filler pic x(05) value '0500D'. 03 filler pic x(05) value '0100C'. 03 filler pic x(05) value '0050L'. 03 filler pic x(05) value '0010X'. 03 filler pic x(05) value '0005V'. 03 filler pic x(05) value '0001I'. 01 filler redefines ws-tbl-table-def. 03 ws-tbl-roman occurs 07 times indexed by rx. 05 ws-tbl-rom-val pic 9(04). 05 ws-tbl-rom-ch pic x(01). 01 ws-number pic s9(05) value 0. 01 ws-number-pic pic zzzz9-. PROCEDURE DIVISION. accept inp-roman perform until inp-roman = ' ' move zeroes to inp-roman-digits perform varying i from 1 by +1 until inp-rom-ch (i) = ' ' set rx to 1 search ws-tbl-roman at end move 0 to inp-rom-digit (i) when ws-tbl-rom-ch (rx) = inp-rom-ch (i) set inp-rom-digit (i) to rx end-search end-perform compute l = i - 1 move 0 to ws-number perform varying i from 1 by +1 until i > l or inp-rom-digit (i) = 0 compute j = inp-rom-digit (i) compute k = inp-rom-digit (i + 1) if ws-tbl-rom-val (k) > ws-tbl-rom-val (j) compute ws-number = ws-number - ws-tbl-rom-val (j) else compute ws-number = ws-number + ws-tbl-rom-val (j) end-if end-perform move ws-number to ws-number-pic display '----------' display 'roman=' inp-roman display 'arabic=' ws-number-pic if i < l or ws-number = 0 display 'invalid/incomplete roman numeral at pos 'i ' found ' inp-rom-ch (i) end-if accept inp-roman end-perform stop run . END PROGRAM UNROMAN. ``` {{out}} input was supplied via STDIN ```txt ---------- roman=MCMLXXXVIII arabic= 1988 ---------- roman=MIX arabic= 1009 ---------- roman=MDCCCLXXXVII arabic= 1887 ---------- roman=IX arabic= 9 ---------- roman=MMMDCCCLXXXVIII arabic= 3888 ---------- roman=K arabic= 0 invalid/incomplete roman numeral at pos 01 found K ---------- roman=MIXT arabic= 1009 invalid/incomplete roman numeral at pos 04 found T ---------- roman=MCMB arabic= 1900 invalid/incomplete roman numeral at pos 04 found B ``` ## CoffeeScript ```coffeescript roman_to_demical = (s) -> # s is well-formed Roman Numeral >= I numbers = M: 1000 D: 500 C: 100 L: 50 X: 10 V: 5 I: 1 result = 0 for c in s num = numbers[c] result += num if old_num < num # If old_num exists and is less than num, then # we need to subtract it twice, once because we # have already added it on the last pass, and twice # to conform to the Roman convention that XC = 90, # not 110. result -= 2 * old_num old_num = num result tests = IV: 4 XLII: 42 MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 for roman, expected of tests dec = roman_to_demical(roman) console.log "error" if dec != expected console.log "#{roman} = #{dec}" ``` ## Common Lisp ```lisp (defun mapcn (chars nums string) (loop as char across string as i = (position char chars) collect (and i (nth i nums)))) (defun parse-roman (R) (loop with nums = (mapcn "IVXLCDM" '(1 5 10 50 100 500 1000) R) as (A B) on nums if A sum (if (and B (< A B)) (- A) A))) ``` Description: ```txt Mapcn is a function to map characters to numbers. It uses the mapping between its first two arguments, chars and nums, to map its 3rd argument, string, to a list of numbers. If a character of string is missing from chars, its number will be nil. Parse-roman uses mapcn to map R to a list of numbers, then iterates that list with A and B, adding A to the total whenever it's not less than B, and subtracting it when it is. If A is nil, it's skipped. Such as when the character is not Roman. If B is nil, A is added and not subtracted. Such as at the end of the list, or when a non-Roman character, such as a space, is embedded in the Roman. ``` Test code: ```lisp (dolist (r '("MCMXC" "MDCLXVI" "MMVIII")) (format t "~a:~10t~d~%" r (parse-roman r))) ``` {{out}} ```txt MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008 ``` ## D ```d import std.regex, std.algorithm; int toArabic(in string s) /*pure nothrow*/ { static immutable weights = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]; static immutable symbols = ["M","CM","D","CD","C","XC", "L","XL","X","IX","V","IV","I"]; int arabic; foreach (m; s.matchAll("CM|CD|XC|XL|IX|IV|[MDCLXVI]".regex)) arabic += weights[symbols.countUntil(m.hit)]; return arabic; } void main() { assert("MCMXC".toArabic == 1990); assert("MMVIII".toArabic == 2008); assert("MDCLXVI".toArabic == 1666); } ``` Alternative more functional version: ```d import std.regex, std.algorithm; immutable uint[string] w2s; pure nothrow 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]; } uint toArabic(in string s) /*pure nothrow*/ @safe /*@nogc*/ { return s .matchAll("CM|CD|XC|XL|IX|IV|[MDCLXVI]".regex) .map!(m => w2s[m.hit]) .sum; } void main() { assert("MCMXC".toArabic == 1990); assert("MMVIII".toArabic == 2008); assert("MDCLXVI".toArabic == 1666); } ``` =={{header|Delphi}}/{{header|Pascal}}== ```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. ``` ## ECL The best declarative approach: ```ECL MapChar(STRING1 c) := CASE(c,'M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1,0); RomanDecode(STRING s) := FUNCTION dsS := DATASET([{s}],{STRING Inp}); R := { INTEGER2 i; }; R Trans1(dsS le,INTEGER pos) := TRANSFORM SELF.i := MapChar(le.Inp[pos]) * IF ( MapChar(le.Inp[pos]) < MapChar(le.Inp[pos+1]), -1, 1 ); END; RETURN SUM(NORMALIZE(dsS,LENGTH(TRIM(s)),Trans1(LEFT,COUNTER)),i); END; RomanDecode('MCMLIV'); //1954 RomanDecode('MCMXC'); //1990 RomanDecode('MMVIII'); //2008 RomanDecode('MDCLXVI'); //1666 RomanDecode('MDLXVI'); //1566 ``` Here's an alternative that emulates the wat procedural code would approach the problem: ```ECL IMPORT STD; RomanDecode(STRING s) := FUNCTION SetWeights := [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]; SetSymbols := ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I']; ProcessRec := RECORD UNSIGNED val; STRING Roman; END; dsSymbols := DATASET(13,TRANSFORM(ProcessRec,SELF.Roman := s, SELF := [])); RECORDOF(dsSymbols) XF(dsSymbols L, dsSymbols R, INTEGER C) := TRANSFORM ThisRoman := IF(C=1,R.Roman,L.Roman); IsDone := ThisRoman = ''; Repeatable := C IN [1,5,9,13]; SymSize := IF(C % 2 = 0, 2, 1); IsNext := STD.Str.StartsWith(ThisRoman,SetSymbols[C]); SymLen := IF(IsNext, IF(NOT Repeatable, SymSize, MAP(NOT IsDone AND ThisRoman[1] = ThisRoman[2] AND ThisRoman[1] = ThisRoman[3] => 3, NOT IsDone AND ThisRoman[1] = ThisRoman[2] => 2, NOT IsDone => 1, 0)), 0); SymbolWeight(STRING s) := IF(NOT Repeatable, SetWeights[C], CHOOSE(LENGTH(s),SetWeights[C],SetWeights[C]*2,SetWeights[C]*3,0)); SELF.Roman := IF(IsDone,ThisRoman,ThisRoman[SymLen+1..]); SELF.val := IF(IsDone,L.val,L.Val + IF(IsNext,SymbolWeight(ThisRoman[1..SymLen]),0)); END; i := ITERATE(dsSymbols,XF(LEFT,RIGHT,COUNTER)); RETURN i[13].val; END; RomanDecode('MCMLIV'); //1954 RomanDecode('MCMXC'); //1990 RomanDecode('MMVIII'); //2008 RomanDecode('MDCLXVI'); //1666 RomanDecode('MDLXVI'); //1566 ``` ## Eiffel This solution is case insensitive. It performs no input validation other than checking that all Roman digits in the input string are one of M, D, C, L, X, V, and I. ```Eiffel class APPLICATION create make feature {NONE} -- Initialization make local numbers: ARRAY [STRING] do numbers := <<"MCMXC", "MMVIII", "MDCLXVI", -- 1990 2008 1666 "MMMCLIX", "MCMLXXVII", "MMX">> -- 3159 1977 2010 across numbers as n loop print (n.item + " in Roman numerals is " + roman_to_decimal (n.item).out + " in decimal Arabic numerals.") print ("%N") end end feature -- Roman numerals roman_to_decimal (a_str: STRING): INTEGER -- Decimal representation of Roman numeral `a_str' require is_roman (a_str) local l_pos: INTEGER cur: INTEGER -- Value of the digit read in the current iteration prev: INTEGER -- Value of the digit read in the previous iteration do from l_pos := 0 Result := 0 prev := 1 + max_digit_value until l_pos = a_str.count loop l_pos := l_pos + 1 cur := roman_digit_to_decimal (a_str.at (l_pos)) if cur <= prev then -- Add nonincreasing digit Result := Result + cur else -- Subtract previous digit from increasing digit Result := Result - prev + (cur - prev) end prev := cur end ensure Result >= 0 end is_roman (a_string: STRING): BOOLEAN -- Is `a_string' a valid sequence of Roman digits? do Result := across a_string as c all is_roman_digit (c.item) end end feature {NONE} -- Implementation max_digit_value: INTEGER = 1000 is_roman_digit (a_char: CHARACTER): BOOLEAN -- Is `a_char' a valid Roman digit? local l_char: CHARACTER do l_char := a_char.as_upper inspect l_char when 'I', 'V', 'X', 'L', 'C', 'D', 'M' then Result := True else Result := False end end roman_digit_to_decimal (a_char: CHARACTER): INTEGER -- Decimal representation of Roman digit `a_char' require is_roman_digit (a_char) local l_char: CHARACTER do l_char := a_char.as_upper inspect l_char when 'I' then Result := 1 when 'V' then Result := 5 when 'X' then Result := 10 when 'L' then Result := 50 when 'C' then Result := 100 when 'D' then Result := 500 when 'M' then Result := 1000 end ensure Result > 0 end end ``` ## Elena ELENA 4.x : ```elena import extensions; import system'collections; import system'routines; static RomanDictionary = new Dictionary() .setAt("I".toChar(), 1) .setAt("V".toChar(), 5) .setAt("X".toChar(), 10) .setAt("L".toChar(), 50) .setAt("C".toChar(), 100) .setAt("D".toChar(), 500) .setAt("M".toChar(), 1000); extension op : String { toRomanInt() { var minus := 0; var s := self.upperCase(); var total := 0; for(int i := 0, i < s.Length, i += 1) { var thisNumeral := RomanDictionary[s[i]] - minus; if (i >= s.Length - 1 || thisNumeral + minus >= RomanDictionary[s[i + 1]]) { total += thisNumeral; minus := 0 } else { minus := thisNumeral } }; ^ total } } public program() { console.printLine("MCMXC: ", "MCMXC".toRomanInt()); console.printLine("MMVIII: ", "MMVIII".toRomanInt()); console.printLine("MDCLXVI:", "MDCLXVI".toRomanInt()) } ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI:1666 ``` ## Elixir {{trans|Erlang}} ```elixir defmodule Roman_numeral do def decode([]), do: 0 def decode([x]), do: to_value(x) def decode([h1, h2 | rest]) do case {to_value(h1), to_value(h2)} do {v1, v2} when v1 < v2 -> v2 - v1 + decode(rest) {v1, _} -> v1 + decode([h2 | rest]) end end defp to_value(?M), do: 1000 defp to_value(?D), do: 500 defp to_value(?C), do: 100 defp to_value(?L), do: 50 defp to_value(?X), do: 10 defp to_value(?V), do: 5 defp to_value(?I), do: 1 end Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI', 'IIIID'], fn clist -> IO.puts "#{clist}\t: #{Roman_numeral.decode(clist)}" end) ``` {{out}} ```txt MCMXC : 1990 MMVIII : 2008 MDCLXVI : 1666 ``` ## Emacs Lisp ```lisp (defun ro2ar (RN) "translate a roman number RN into arabic number. Its argument RN is wether a symbol, wether a list. Returns the arabic number. (ro2ar 'C) gives 100, (ro2ar '(X X I V)) gives 24" (cond ((eq RN 'M) 1000) ((eq RN 'D) 500) ((eq RN 'C) 100) ((eq RN 'L) 50) ((eq RN 'X) 10) ((eq RN 'V) 5) ((eq RN 'I) 1) ((null (cdr RN)) (ro2ar (car RN))) ;; stop recursion ((< (ro2ar (car RN)) (ro2ar (car (cdr RN)))) (- (ro2ar (cdr RN)) (ro2ar (car RN)))) ;; "IV" -> 5-1=4 (t (+ (ro2ar (car RN)) (ro2ar (cdr RN)))))) ;; "VI" -> 5+1=6 ``` {{out}} ```txt (ro2ar '(M D C L X V I)) -> 1666 ``` ## Erlang Putting the character X into a list, [X], creates a string with a single character. ```Erlang -module( roman_numerals ). -export( [decode_from_string/1]). to_value($M) -> 1000; to_value($D) -> 500; to_value($C) -> 100; to_value($L) -> 50; to_value($X) -> 10; to_value($V) -> 5; to_value($I) -> 1. decode_from_string([]) -> 0; decode_from_string([H1]) -> to_value(H1); decode_from_string([H1, H2 |Rest]) -> case {to_value(H1), to_value(H2)} of {V1, V2} when V1 < V2 -> V2 - V1 + decode_from_string(Rest); {V1, V1} -> V1 + V1 + decode_from_string(Rest); {V1, _} -> V1 + decode_from_string([H2|Rest]) end. ``` {{out}} ```txt 10> roman_numerals:decode_from_string("MCMXC"). 1990 11> roman_numerals:decode_from_string("MMVIII"). 2008 12> roman_numerals:decode_from_string("MDCLXVI"). 1666 ``` ## ERRE ```ERRE PROGRAM ROMAN2ARAB DIM R%[7] PROCEDURE TOARAB(ROMAN$->ANS%) LOCAL I%,J%,P%,N% FOR I%=LEN(ROMAN$) TO 1 STEP -1 DO J%=INSTR("IVXLCDM",MID$(ROMAN$,I%,1)) IF J%=0 THEN ANS%=-9999 ! illegal character EXIT PROCEDURE END IF IF J%>=P% THEN N%+=R%[J%] ELSE N%-=R%[J%] END IF P%=J% END FOR ANS%=N% END PROCEDURE BEGIN R%[]=(0,1,5,10,50,100,500,1000) TOARAB("MCMXCIX"->ANS%) PRINT(ANS%) TOARAB("MMXII"->ANS%) PRINT(ANS%) TOARAB("MDCLXVI"->ANS%) PRINT(ANS%) TOARAB("MMMDCCCLXXXVIII"->ANS%) PRINT(ANS%) END PROGRAM ``` If the answer is -9999, roman number is illegal. ## Euphoria {{trans|PureBasic}} ```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") ``` {{out}} ```txt 1999 1666 25 954 2011 ``` =={{header|F Sharp|F#}}== This implementation uses tail recursion. The accumulator (arabic) and the last roman digit (lastval) are recursively passed as each element of the list is consumed. ```fsharp let decimal_of_roman roman = let rec convert arabic lastval = function | head::tail -> let n = match head with | 'M' | 'm' -> 1000 | 'D' | 'd' -> 500 | 'C' | 'c' -> 100 | 'L' | 'l' -> 50 | 'X' | 'x' -> 10 | 'V' | 'v' -> 5 | 'I' | 'i' -> 1 | _ -> 0 let op = if n > lastval then (-) else (+) convert (op arabic lastval) n tail | _ -> arabic + lastval convert 0 0 (Seq.toList roman) ;; ``` Here is an alternative implementation that uses Seq(uence).fold. It threads a Tuple of the state (accumulator, last roman digit) through the list of characters. ```fsharp let decimal_of_roman roman = let convert (arabic,lastval) c = let n = match c with | 'M' | 'm' -> 1000 | 'D' | 'd' -> 500 | 'C' | 'c' -> 100 | 'L' | 'l' -> 50 | 'X' | 'x' -> 10 | 'V' | 'v' -> 5 | 'I' | 'i' -> 1 | _ -> 0 let op = if n > lastval then (-) else (+) (op arabic lastval, n) let (arabic, lastval) = Seq.fold convert (0,0) roman arabic + lastval ;; ``` Test code: ```fsharp let tests = ["MCMXC"; "MMVIII"; "MDCLXVII"; "MMMCLIX"; "MCMLXXVII"; "MMX"] for test in tests do Printf.printf "%s: %d\n" test (decimal_of_roman test) ;; ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVII: 1667 MMMCLIX: 3159 MCMLXXVII: 1977 MMX: 2010 ``` ## Factor A roman numeral library ships with Factor. ```factor USE: roman ( scratchpad ) "MMMCCCXXXIII" roman> . 3333 ``` Implementation for decoding: ```factor CONSTANT: roman-digits { "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" } CONSTANT: roman-values { 1000 900 500 400 100 90 50 40 10 9 5 4 1 } : roman> ( str -- n ) >lower [ roman-digit>= ] monotonic-split [ roman-value ] map-sum ; : roman-digit>= ( ch1 ch2 -- ? ) [ roman-digit-index ] bi@ >= ; : roman-digit-index ( ch -- n ) 1string roman-digits index ; : roman-value (seq -- n ) [ [ roman-digit-value ] map ] [ all-eq? ] bi [ sum ] [ first2 swap - ] if ; : roman-digit-value ( ch -- n ) roman-digit-index roman-values nth ; ``` ## Forth ```forth create (arabic) 1000 128 * char M + , 500 128 * char D + , 100 128 * char C + , 50 128 * char L + , 10 128 * char X + , 5 128 * char V + , 1 128 * char I + , does> 7 cells bounds do i @ over over 127 and = if nip 7 rshift leave else drop then 1 cells +loop dup ; : >arabic 0 dup >r >r begin over over while c@ dup (arabic) rot <> while r> over r> over over > if 2* negate + else drop then + swap >r >r 1 /string repeat then drop 2drop r> r> drop ; s" MCMLXXXIV" >arabic . ``` ```forth \ decode roman numerals using Forth methodology \ create words to describe and solve the problem \ ANS/ISO Forth \ state holders VARIABLE OLDNDX VARIABLE CURNDX VARIABLE NEGFLAG DECIMAL CREATE VALUES ( -- addr) 0 , 1 , 5 , 10 , 50 , 100 , 500 , 1000 , : NUMERALS ( -- addr len) S" IVXLCDM" ; \ 1st char is a blank : [] ( n addr -- addr') SWAP CELLS + ; \ array address calc. : INIT ( -- ) CURNDX OFF OLDNDX OFF NEGFLAG OFF ; : REMEMBER ( ndx -- ndx ) CURNDX @ OLDNDX ! DUP CURNDX ! ; : ]VALUE@ ( ndx -- n ) REMEMBER VALUES [] @ ; HEX : TOUPPER ( char -- char ) 05F AND ; DECIMAL : >INDEX ( char -- ndx) TOUPPER >R NUMERALS TUCK R> SCAN NIP - DUP 7 > ABORT" Invalid Roman numeral" ; : >VALUE ( char -- n ) >INDEX ]VALUE@ ; : ?ILLEGAL ( ndx -- ) CURNDX @ OLDNDX @ = NEGFLAG @ AND ABORT" Illegal format" ; : ?NEGATE ( n -- +n | -n) \ conditional NEGATE CURNDX @ OLDNDX @ < IF NEGFLAG ON NEGATE ELSE ?ILLEGAL NEGFLAG OFF THEN ; : >ARABIC ( addr len -- n ) INIT 0 -ROT \ accumulator under the stack string args 1- BOUNDS \ convert addr len to two addresses SWAP DO \ index the string from back to front I C@ >VALUE ?NEGATE + -1 +LOOP ; Alternative Version Forth Console Test ```txt \ test code ok S" i" >ARABIC . 1 ok S" ii" >ARABIC . 2 ok S" iv" >ARABIC . 4 ok S" mdclxvi" >ARABIC . 1666 ok S" mm" >ARABIC . 2000 ok S" mmm" >ARABIC . 3000 ok S" MCMLIV" >ARABIC . 1954 ok S" mcmxlvi" >ARABIC . 1946 ok S" mdc" >ARABIC . 1600 ok S" mdcl" >ARABIC . 1650 ok S" mdclxvi" >ARABIC . 1666 ok S" mcmlxxxiv" >ARABIC . 1984 ok ## Fortran {{works with|Fortran|90 and later}} ```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 ``` {{out}} ```txt 1990 2008 1666 ``` ## FreeBASIC ```freebasic ' FB 1.05.0 Win64 Function romanDecode(roman As Const String) As Integer If roman = "" Then Return 0 '' zero denotes invalid roman number Dim roman1(0 To 2) As String = {"MMM", "MM", "M"} Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"} Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"} Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"} Dim As Integer i, value = 0, length = 0 Dim r As String = UCase(roman) For i = 0 To 2 If Left(r, Len(roman1(i))) = roman1(i) Then value += 1000 * (3 - i) length = Len(roman1(i)) r = Mid(r, length + 1) length = 0 Exit For End If Next For i = 0 To 8 If Left(r, Len(roman2(i))) = roman2(i) Then value += 100 * (9 - i) length = Len(roman2(i)) r = Mid(r, length + 1) length = 0 Exit For End If Next For i = 0 To 8 If Left(r, Len(roman3(i))) = roman3(i) Then value += 10 * (9 - i) length = Len(roman3(i)) r = Mid(r, length + 1) length = 0 Exit For End If Next For i = 0 To 8 If Left(r, Len(roman4(i))) = roman4(i) Then value += 9 - i length = Len(roman4(i)) Exit For End If Next ' Can't be a valid roman number if there are any characters left If Len(r) > length Then Return 0 Return value End Function Dim a(2) As String = {"MCMXC", "MMVIII" , "MDCLXVI"} For i As Integer = 0 To 2 Print a(i); Tab(8); " =>"; romanDecode(a(i)) Next Print Print "Press any key to quit" Sleep ``` {{out}} ```txt MCMXC => 1990 MMVIII => 2008 MDCLXVI => 1666 ``` ## FutureBasic ```futurebasic local fn RomantoDecimal( roman as Str15 ) as short dim as short i, n, preNum, num preNum = 0 : num = 0 for i = roman[0] to 1 step -1 n = 0 if roman[i] = _"M" then n = 1000 if roman[i] = _"D" then n = 500 if roman[i] = _"C" then n = 100 if roman[i] = _"L" then n = 50 if roman[i] = _"X" then n = 10 if roman[i] = _"V" then n = 5 if roman[i] = _"I" then n = 1 if n < preNum then num = num - n else num = num + n preNum = n next end fn = num print " MCMXC ="; fn RomantoDecimal( "MCMXC" ) print " MMVIII ="; fn RomantoDecimal( "MMVIII" ) print " MMXVI ="; fn RomantoDecimal( "MMXVI" ) print "MDCLXVI ="; fn RomantoDecimal( "MDCLXVI" ) print " MCMXIV ="; fn RomantoDecimal( "MCMXIV" ) print " DXIII ="; fn RomantoDecimal( "DXIII" ) print " M ="; fn RomantoDecimal( "M" ) print " DXIII ="; fn RomantoDecimal( "DXIII" ) print " XXXIII ="; fn RomantoDecimal( "XXXIII" ) ``` Output: ```txt MCMXC = 1990 MMVIII = 2008 MMXVI = 2016 MDCLXVI = 1666 MCMXIV = 1914 DXIII = 513 M = 1000 DXIII = 513 XXXIII = 33 ``` ## Gambas ```gambas 'This code will create a GUI Form and Objects and carry out the Roman Numeral convertion as you type 'The input is case insensitive 'A basic check for invalid charaters is made hTextBox As TextBox 'To allow the creation of a TextBox hValueBox As ValueBox 'To allow the creation of a ValueBox Public Sub Form_Open() 'Form opens.. SetUpForm 'Go to the SetUpForm Routine hTextBox.text = "MCMXC" 'Put a Roman numeral in the TextBox End Public Sub TextBoxInput_Change() 'Each time the TextBox text changes.. Dim cRomanN As Collection = ["M": 1000, "D": 500, "C": 100, "L": 50, "X": 10, "V": 5, "I": 1] 'Collection of nemerals e.g 'M' = 1000 Dim cMinus As Collection = ["IV": -2, "IX": -2, "XL": -20, "XC": - 20, "CD": -200, "CM": -200] 'Collection of the 'one less than' numbers e.g. 'IV' = 4 Dim sClean, sTemp As String 'Various string variables Dim siCount As Short 'Counter Dim iTotal As Integer 'Stores the total of the calculation hTextBox.Text = UCase(hTextBox.Text) 'Make any text in the TextBox upper case For siCount = 1 To Len(hTextBox.Text) 'Loop through each character in the TextBox If InStr("MDCLXVI", Mid(hTextBox.Text, siCount, 1)) Then 'If a Roman numeral exists then.. sClean &= Mid(hTextBox.Text, siCount, 1) 'Put it in 'sClean' (Stops input of non Roman numerals) End If Next hTextBox.Text = sClean 'Put the now clean text in the TextBox For siCount = 1 To Len(hTextBox.Text) 'Loop through each character in the TextBox iTotal += cRomanN[Mid(hTextBox.Text, siCount, 1)] 'Total up all the characters, note 'IX' will = 11 not 9 Next For Each sTemp In cMinus 'Loop through each item in the cMinus Collection If InStr(sClean, cMinus.Key) > 0 Then iTotal += Val(sTemp) 'If a 'Minus' value is in the string e.g. 'IX' which has been calculated at 11 subtract 2 = 9 Next hValueBox.text = iTotal 'Display the total End Public Sub SetUpForm() 'Create the Objects for the Form Dim hLabel1, hLabel2 As Label 'For 2 Labels Me.height = 150 'Form Height Me.Width = 300 'Form Width Me.Padding = 20 'Form padding (border) Me.Text = "Roman Numeral converter" 'Text in Form header Me.Arrangement = Arrange.Vertical 'Form arrangement hLabel1 = New Label(Me) 'Create a Label hLabel1.Height = 21 'Label Height hLabel1.expand = True 'Expand the Label hLabel1.Text = "Enter a Roman numeral" 'Put text in the Label hTextBox = New TextBox(Me) As "TextBoxInput" 'Set up a TextBox with an Event Label hTextBox.Height = 21 'TextBox height hTextBox.expand = True 'Expand the TextBox hLabel2 = New Label(Me) 'Create a Label hLabel2.Height = 21 'Label Height hLabel2.expand = True 'Expand the Label hLabel2.Text = "The decimal equivelent is: -" 'Put text in the Label hValueBox = New ValueBox(Me) 'Create a ValueBox hValueBox.Height = 21 'ValuBox Height hValueBox.expand = True 'Expand the ValueBox hValueBox.ReadOnly = True 'Set ValueBox to Read Only End ``` '''[http://www.cogier.com/gambas/Roman%20Numeral%20converter.png Click here for image of running code]''' ## Go For fluff, the unicode overbar is recognized as a factor of 1000, [http://en.wikipedia.org/wiki/Roman_numerals#Large_numbers as described in WP]. ```go package main import ( "errors" "fmt" ) var m = map[rune]int{ 'I': 1, 'V': 5, 'X': 10, 'L': 50, 'C': 100, 'D': 500, 'M': 1000, } func parseRoman(s string) (r int, err error) { if s == "" { return 0, errors.New("Empty string") } is := []rune(s) // easier to convert string up front var c0 rune // 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 == '\u0305' // unicode overbar combining character if k { if i == 0 { return 0, errors.New( "Overbar combining character invalid at position 0") } i-- c = is[i] } cv := m[c] if cv == 0 { if c == 0x0305 { return 0, fmt.Errorf( "Overbar combining character invalid at position %d", i) } else { return 0, fmt.Errorf( "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) } } } ``` {{out}} ```txt MCMXC == 1990 MMVIII == 2008 MDCLXVI == 1666 ``` Simpler: ```go package main import ( "fmt" ) var m = map[rune]int{ 'I': 1, 'V': 5, 'X': 10, 'L': 50, 'C': 100, 'D': 500, 'M': 1000, } // function, per task description func from_roman(roman string) (arabic int) { last_digit := 1000 for _, r := range roman { digit := m[r] if last_digit < digit { arabic -= 2 * last_digit } last_digit = digit arabic += digit } return arabic } func main() { // parse three numbers mentioned in task description for _, roman_digit := range []string{"MCMXC", "MMVIII", "MDCLXVI"} { fmt.Printf("%-10s == %d\n", roman_digit, from_roman(roman_digit)) } } ``` ## Golo ```golo #!/usr/bin/env golosh ---- This module converts a Roman numeral into a decimal number. ---- module Romannumeralsdecode augment java.lang.Character { function decode = |this| -> match { when this == 'I' then 1 when this == 'V' then 5 when this == 'X' then 10 when this == 'L' then 50 when this == 'C' then 100 when this == 'D' then 500 when this == 'M' then 1000 otherwise 0 } } augment java.lang.String { function decode = |this| { var accumulator = 0 foreach i in [0..this: length()] { let currentChar = this: charAt(i) let nextChar = match { when i + 1 < this: length() then this: charAt(i + 1) otherwise null } if (currentChar: decode() < (nextChar?: decode() orIfNull 0)) { # if this is something like IV or IX or whatever accumulator = accumulator - currentChar: decode() } else { accumulator = accumulator + currentChar: decode() } } return accumulator } } function main = |args| { println("MCMXC = " + "MCMXC": decode()) println("MMVIII = " + "MMVIII": decode()) println("MDCLXVI = " + "MDCLXVI": decode()) } ``` ## Groovy Solution: ```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.. def sign = (i == L - 1 || digits[i] >= digits[i+1]) ? 1 : -1 total + sign * digits[i].magnitude } } } ``` Test: ```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')} """ ``` {{out}} ```txt 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 ### =Simple declarative idiom= Compiles with GHC. ```Haskell module Main where ------------------------ -- DECODER FUNCTION -- ------------------------ decodeDigit :: Char -> Int decodeDigit 'I' = 1 decodeDigit 'V' = 5 decodeDigit 'X' = 10 decodeDigit 'L' = 50 decodeDigit 'C' = 100 decodeDigit 'D' = 500 decodeDigit 'M' = 1000 decodeDigit _ = error "invalid digit" -- We process a Roman numeral from right to left, digit by digit, adding the value. -- If a digit is lower than the previous then its value is negative. -- The first digit is always positive. decode roman = decodeRoman startValue startValue rest where (first:rest) = reverse roman startValue = decodeDigit first decodeRoman :: Int -> Int -> [Char] -> Int decodeRoman lastSum _ [] = lastSum decodeRoman lastSum lastValue (digit:rest) = decodeRoman updatedSum digitValue rest where digitValue = decodeDigit digit updatedSum = (if digitValue < lastValue then (-) else (+)) lastSum digitValue ------------------ -- TEST SUITE -- ------------------ main = do test "MCMXC" 1990 test "MMVIII" 2008 test "MDCLXVI" 1666 test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark) where arabic = decode roman remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")" ``` {{Out}} ```txt MCMXC = 1990 (PASS) MMVIII = 2008 (PASS) MDCLXVI = 1666 (PASS) ``` ### =Same logic as above but in a functional idiom= ```Haskell module Main where ------------------------ -- DECODER FUNCTION -- ------------------------ decodeDigit :: Char -> Int decodeDigit 'I' = 1 decodeDigit 'V' = 5 decodeDigit 'X' = 10 decodeDigit 'L' = 50 decodeDigit 'C' = 100 decodeDigit 'D' = 500 decodeDigit 'M' = 1000 decodeDigit _ = error "invalid digit" -- We process a Roman numeral from right to left, digit by digit, adding the value. -- If a digit is lower than the previous then its value is negative. -- The first digit is always positive. decode roman = fst (foldl addValue (0, 0) (reverse roman)) where addValue (lastSum, lastValue) digit = (updatedSum, value) where value = decodeDigit digit; updatedSum = (if value < lastValue then (-) else (+)) lastSum value ------------------ -- TEST SUITE -- ------------------ main = do test "MCMXC" 1990 test "MMVIII" 2008 test "MDCLXVI" 1666 test roman expected = putStrLn (roman ++ " = " ++ (show (arabic)) ++ remark) where arabic = decode roman remark = " (" ++ (if arabic == expected then "PASS" else ("FAIL, expected " ++ (show expected))) ++ ")" ``` ### =List comprehension= ```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 ] ``` Usage: ```txt ghci> toArabic "MCMXC" 1990 ghci> toArabic "MMVIII" 2008 ghci> toArabic "MDCLXVI" 1666 ``` ### =mapAccum= Or, expressing '''romanValue''' in terms of '''mapAccumL''' (avoiding recursive descent, and visiting each k v pair just once) ```Haskell import Data.List (mapAccumL, isPrefixOf) import Control.Arrow ((***)) romanValue :: String -> Int romanValue = let tr s (k, v) = until (not . isPrefixOf k . fst) (drop (length k) *** (v +)) (s, 0) in sum . snd . flip (mapAccumL tr) [ ("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) ] main :: IO () main = mapM_ (print . romanValue) ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"] ``` Or, in a '''mapAccumR''' version: ```Haskell import Data.List (mapAccumR) import Data.Map.Strict as M import Data.Maybe (maybe) fromRoman :: String -> Maybe Int fromRoman cs = let go l r | l > r = (-r, l) | otherwise = (r, l) in traverse (`M.lookup` mapRoman) cs >>= (Just . sum . ((:) <$> fst <*> snd) . mapAccumR go 0) mapRoman :: Map Char Int mapRoman = M.fromList $ zip "MDCLXVI " [1000, 500, 100, 50, 10, 5, 1, 0] -- TEST --------------------------------------------------- main :: IO () main = putStrLn $ fTable "Decoding Roman numbers:\n" show (maybe "Unrecognised character" show) fromRoman ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVIII", "MMXBIII"] -- FORMATTING --------------------------------------------- fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String fTable s xShow fxShow f xs = let w = maximum (length . xShow <$> xs) rjust n c = drop <$> length <*> (replicate n c ++) in unlines $ s : fmap (((++) . rjust w ' ' . xShow) <*> ((" -> " ++) . fxShow . f)) xs ``` {{Out}} ```txt Decoding Roman numbers: "MDCLXVI" -> 1666 "MCMXC" -> 1990 "MMVIII" -> 2008 "MMXVI" -> 2016 "MMXVIII" -> 2018 "MMXBIII" -> Unrecognised character ``` ### =Fold= An alternative solution using a fold. (This turns out to be the fastest of the four approaches here) {{Trans|F#}} ```Haskell import qualified Data.Map.Strict as M fromRoman :: String -> Int fromRoman xs = partialSum + lastDigit where (partialSum, lastDigit) = foldl accumulate (0, 0) (evalRomanDigit <$> xs) accumulate (partial, lastDigit) newDigit | newDigit <= lastDigit = (partial + lastDigit, newDigit) | otherwise = (partial - lastDigit, newDigit) mapRoman :: M.Map Char Int mapRoman = M.fromList [ ('I', 1) , ('V', 5) , ('X', 10) , ('L', 50) , ('C', 100) , ('D', 500) , ('M', 1000) ] evalRomanDigit :: Char -> Int evalRomanDigit c = let mInt = M.lookup c mapRoman in case mInt of Just x -> x _ -> error $ c : " is not a roman digit" main :: IO () main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"] ``` Where the left fold above could also be rewritten [http://wiki.haskell.org/Foldr_Foldl_Foldl%27 | as a right fold]. ```Haskell import qualified Data.Map.Strict as M import Data.Maybe (maybe) import Data.Bool (bool) mapRoman :: M.Map Char Int mapRoman = M.fromList $ zip "IVXLCDM" $ scanl (*) 1 (cycle [5, 2]) fromRoman :: String -> Maybe Int fromRoman cs = traverse (`M.lookup` mapRoman) cs >>= (Just . snd . foldr (\l (r, n) -> (l, bool (-) (+) (l >= r) n l)) (0, 0)) -- TEST --------------------------------------------------- main :: IO () main = putStrLn $ fTable "Roman numeral decoding as a right fold:\n" show (maybe "(Unrecognised character seen)" show) fromRoman ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII", "QQXVII"] -- FORMATTING --------------------------------------------- fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String fTable s xShow fxShow f xs = let w = maximum (length . xShow <$> xs) rjust n c = drop <$> length <*> (replicate n c ++) in unlines $ s : fmap (((++) . rjust w ' ' . xShow) <*> ((" -> " ++) . fxShow . f)) xs ``` {{Out}} ```txt Roman numeral decoding as a right fold: "MDCLXVI" -> 1666 "MCMXC" -> 1990 "MMVIII" -> 2008 "MMXVI" -> 2016 "MMXVII" -> 2017 "QQXVII" -> (Unrecognised character seen) ``` ### =sum . catMaybes= Summing a list of Map.lookup results on indexed [Char, Char] pairs. (Probably more trouble than it's worth in practice, but at least an illustration of some Data.Maybe and Data.Map functions) ```Haskell import qualified Data.Map.Strict as M (Map, fromList, lookup) import Data.Maybe (isNothing, isJust, fromJust, catMaybes) import Data.List (mapAccumL) mapRoman :: M.Map String Int mapRoman = M.fromList [ ("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) ] fromRoman :: String -> Int fromRoman s = let value k = M.lookup k mapRoman in sum . catMaybes . snd $ mapAccumL (\mi (l, r, i) -> let mValue = value [l, r] -- mapRoman lookup of [left, right] Chars (lastPair, pairValue) | isJust mValue = (Just i, mValue) -- Pair match: index updated | isNothing mi || i - fromJust mi > 1 = (mi, value [l]) | otherwise = (mi, Nothing) -- Left Char was counted in pair in (lastPair, pairValue)) Nothing -- Accumulator – maybe Index to last matched Char pair (zip3 s (tail s ++ " ") [0 ..]) -- Indexed character pairs main :: IO () main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"] ``` {{Out}} ```txt [1666,1990,2008,2016,2017] ``` =={{header|Icon}} and {{header|Unicon}}== ```Icon link numbers procedure main() every R := "MCMXC"|"MDCLXVI"|"MMVIII" do write(R, " = ",unroman(R)) end ``` {{libheader|Icon Programming Library}} [http://www.cs.arizona.edu/icon/library/src/procs/numbers.icn numbers.icn provides unroman] The code for this procedure is copied below: ```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 ``` {{out}} ```txt MCMXC = 1990 MDCLXVI = 1666 MMVIII = 2008 ``` ## J ```j rom2d=: [: (+/ .* _1^ 0,~ 2 SET = Collections.unmodifiableSet(EnumSet.allOf(Numeral.class)); private Numeral(long weight) { this.weight = weight; } public static Numeral getLargest(long weight) { return SET.stream() .filter(numeral -> weight >= numeral.weight) .findFirst() .orElse(I) ; } }; public static String encode(long n) { return LongStream.iterate(n, l -> l - Numeral.getLargest(l).weight) .limit(Numeral.values().length) .filter(l -> l > 0) .mapToObj(Numeral::getLargest) .map(String::valueOf) .collect(Collectors.joining()) ; } public static long decode(String roman) { long result = new StringBuilder(roman.toUpperCase()).reverse().chars() .mapToObj(c -> Character.toString((char) c)) .map(numeral -> Enum.valueOf(Numeral.class, numeral)) .mapToLong(numeral -> numeral.weight) .reduce(0, (a, b) -> a + (a <= b ? b : -b)) ; if (roman.charAt(0) == roman.charAt(1)) { result += 2 * Enum.valueOf(Numeral.class, roman.substring(0, 1)).weight; } return result; } public static void test(long n) { System.out.println(n + " = " + encode(n)); System.out.println(encode(n) + " = " + decode(encode(n))); } public static void main(String[] args) { LongStream.of(1999, 25, 944).forEach(RomanNumerals::test); } } ``` {{out}} ```txt 1999 = MCMXCIX MCMXCIX = 1999 25 = XXV XXV = 25 944 = CMXLIV CMXLIV = 944 ``` ## JavaScript ### ES5 ### =Imperative= {{works with|Rhino}} {{works with|SpiderMonkey}} ```javascript var Roman = { Values: [['CM', 900], ['CD', 400], ['XC', 90], ['XL', 40], ['IV', 4], ['IX', 9], ['V', 5], ['X', 10], ['L', 50], ['C', 100], ['M', 1000], ['I', 1], ['D', 500]], UnmappedStr : 'Q', parse: function(str) { var result = 0 for (var i=0; i n function romanValue(s) { // recursion over list of characters // [c] -> n function toArabic(lst) { return lst.length ? function (xs) { var lstParse = chain(mapping, function (lstPair) { return isPrefixOf( lstPair[0], xs ) ? [lstPair[1], drop(lstPair[0].length, xs)] : [] }); return lstParse[0] + toArabic(lstParse[1]); }(lst) : 0 } return toArabic(s.split('')); } // Monadic bind (chain) for lists function chain(xs, f) { return [].concat.apply([], xs.map(f)); } // [a] -> [a] -> Bool function isPrefixOf(lstFirst, lstSecond) { return lstFirst.length ? ( lstSecond.length ? lstFirst[0] === lstSecond[0] && isPrefixOf( lstFirst.slice(1), lstSecond.slice(1) ) : false ) : true; } // Int -> [a] -> [a] function drop(n, lst) { return n <= 0 ? lst : ( lst.length ? drop(n - 1, lst.slice(1)) : [] ); } return lstTest.map(romanValue); })(['MCMXC', 'MDCLXVI', 'MMVIII']); ``` {{Out}} ```JavaScript [1990, 1666, 2008] ``` or, more natively: ```JavaScript (function (lstTest) { function romanValue(s) { return s.length ? function () { var parse = [].concat.apply([], glyphs.map(function (g) { return 0 === s.indexOf(g) ? [trans[g], s.substr(g.length)] : []; })); return parse[0] + romanValue(parse[1]); }() : 0; } var trans = { M: 1E3, CM: 900, D: 500, CD: 400, C: 100, XC: 90, L: 50, XL: 40, X: 10, IX: 9, V: 5, IV: 4, I: 1 }, glyphs = Object.keys(trans); return lstTest.map(romanValue); })(["MCMXC", "MDCLXVI", "MMVIII", "MMMM"]); ``` {{Out}} ```JavaScript [1990, 1666, 2008] ``` ### ES6 ### =Recursion= ```JavaScript (() => { // romanValue :: String -> Int const romanValue = s => s.length ? (() => { const parse = [].concat( ...glyphs.map(g => 0 === s.indexOf(g) ? ( [dctTrans[g], s.substr(g.length)] ) : []) ); return parse[0] + romanValue(parse[1]); })() : 0; // dctTrans :: {romanKey: Integer} const dctTrans = { M: 1E3, CM: 900, D: 500, CD: 400, C: 100, XC: 90, L: 50, XL: 40, X: 10, IX: 9, V: 5, IV: 4, I: 1 }; // glyphs :: [romanKey] const glyphs = Object.keys(dctTrans); // TEST ------------------------------------------------------------------- return ["MCMXC", "MDCLXVI", "MMVIII", "MMMM"].map(romanValue); })(); ``` {{Out}} ```JavaScript [1990,1666,2008,4000] ``` ### =Folding from the right= {{Trans|Haskell}} (fold and foldr examples) ```JavaScript (() => { // Folding from right to left, // lower leftward characters are subtracted, // others are added. // fromRoman :: String -> Int const fromRoman = s => snd(foldr( ([r, n], l) => [l, l >= r ? n + l : n - l], [0, 0], map(charVal, stringChars(s)) )); // charVal :: Char -> Maybe Int const charVal = k => { const v = { I: 1, V: 5, X: 10, L: 50, C: 100, D: 500, M: 1000 }[k]; return v !== undefined ? v : 0; }; // GENERIC FUNCTIONS ------------------------------------------------------ // foldr (a -> b -> b) -> b -> [a] -> b const foldr = (f, a, xs) => xs.reduceRight(f, a); // map :: (a -> b) -> [a] -> [b] const map = (f, xs) => xs.map(f); // snd :: (a, b) -> b const snd = tpl => Array.isArray(tpl) ? tpl[1] : undefined; // stringChars :: String -> [Char] const stringChars = s => s.split(''); // show :: a -> String const show = (...x) => JSON.stringify.apply( null, x.length > 1 ? [x[1], null, x[0]] : x ); // TEST ------------------------------------------------------------------- return show( map(fromRoman, ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]) ); })(); ``` {{Out}} ```txt [1666,1990,2008,2016,2017] ``` ## jq {{works with|jq|1.4}} This version requires the Roman numerals to be presented in upper case. ```jq def fromRoman: def addRoman(n): if length == 0 then n elif startswith("M") then .[1:] | addRoman(1000 + n) elif startswith("CM") then .[2:] | addRoman(900 + n) elif startswith("D") then .[1:] | addRoman(500 + n) elif startswith("CD") then .[2:] | addRoman(400 + n) elif startswith("C") then .[1:] | addRoman(100 + n) elif startswith("XC") then .[2:] | addRoman(90 + n) elif startswith("L") then .[1:] | addRoman(50 + n) elif startswith("XL") then .[2:] | addRoman(40 + n) elif startswith("X") then .[1:] | addRoman(10 + n) elif startswith("IX") then .[2:] | addRoman(9 + n) elif startswith("V") then .[1:] | addRoman(5 + n) elif startswith("IV") then .[2:] | addRoman(4 + n) elif startswith("I") then .[1:] | addRoman(1 + n) else error("invalid Roman numeral: " + tostring) end; addRoman(0); ``` '''Example:''' ```jq [ "MCMXC", "MMVIII", "MDCLXVI" ] | map("\(.) => \(fromRoman)") | .[] ``` {{out}} ```sh $ jq -n -f -r fromRoman.jq MCMXC => 1990 MMVIII => 2008 MDCLXVI => 1666 ``` ## Jsish Duplicate of the Jsish module used in [[Roman_numerals/Encode#Jsish]]. {{out}} ```txt prompt$ jsish -e 'require("Roman"); puts(Roman.fromRoman("MDCLXVI"));' 1666 ``` ## Julia {{works with|Julia|0.6}} '''The Function''': ```julia function parseroman(rnum::AbstractString) romandigits = Dict('I' => 1, 'V' => 5, 'X' => 10, 'L' => 50, 'C' => 100, 'D' => 500, 'M' => 1000) mval = accm = 0 for d in reverse(uppercase(rnum)) val = try romandigits[d] catch throw(DomainError()) end if val > mval maxval = val end if val < mval accm -= val else accm += val end end return accm end ``` This function is rather permissive. There are no limitations on the numbers of Roman numerals nor on their order. Because of this and because any out of order numerals subtract from the total represented, it is possible to represent zero and negative integers. Also mixed case representations are allowed. The function does throw an error if the string contains any invalid characters. '''Test the code''': ```julia test = ["I", "III", "IX", "IVI", "IIM", "CMMDXL", "icv", "cDxLiV", "MCMLD", "ccccccd", "iiiiiv", "MMXV", "MCMLXXXIV", "ivxmm", "SPQR"] for rnum in test @printf("%15s → %s\n", rnum, try parseroman(rnum) catch "not valid" end) end ``` {{out}} ```txt I → 1 III → 3 IX → 11 IVI → 7 IIM → 1002 CMMDXL → 2660 icv → 106 cDxLiV → 666 MCMLD → 2650 ccccccd → 1100 iiiiiv → 10 MMXV → 2015 MCMLXXXIV → 2186 ivxmm → 2016 SPQR → not valid ``` ## K {{trans|J}} ```k romd: {v:1 5 10 50 100 500 1000@"IVXLCDM"?/:x; +/v*_-1^(>':v),0} ``` '''Example:''' ```k romd'("MCMXC";"MMVIII";"MDCLXVI") 1990 2008 1666 ``` ## Kotlin As specified in the task description, there is no attempt to validate the form of the Roman number in the following program - invalid characters and ordering are simply ignored: ```scala // version 1.0.6 fun romanDecode(roman: String): Int { if (roman.isEmpty()) return 0 var n = 0 var last = 'O' for (c in roman) { when (c) { 'I' -> n += 1 'V' -> if (last == 'I') n += 3 else n += 5 'X' -> if (last == 'I') n += 8 else n += 10 'L' -> if (last == 'X') n += 30 else n += 50 'C' -> if (last == 'X') n += 80 else n += 100 'D' -> if (last == 'C') n += 300 else n += 500 'M' -> if (last == 'C') n += 800 else n += 1000 } last = c } return n } fun main(args: Array) { val romans = arrayOf("I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI") for (roman in romans) println("${roman.padEnd(10)} = ${romanDecode(roman)}") } ``` {{out}} ```txt I = 1 III = 3 IV = 4 VIII = 8 XLIX = 49 CCII = 202 CDXXXIII = 433 MCMXC = 1990 MMVIII = 2008 MDCLXVI = 1666 ``` ## Lasso ```Lasso>define br = '\r' //decode roman define decodeRoman(roman::string)::integer => { local(ref = array('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)) local(out = integer) while(#roman->size) => { // need to use neset while instead of query expr to utilize loop_abort while(loop_count <= #ref->size) => { if(#roman->beginswith(#ref->get(loop_count)->first)) => { #out += #ref->get(loop_count)->second #roman->remove(1,#ref->get(loop_count)->first->size) loop_abort } } } return #out } 'MCMXC as integer is '+decodeRoman('MCMXC') br 'MMVIII as integer is '+decodeRoman('MMVIII') br 'MDCLXVI as integer is '+decodeRoman('MDCLXVI') ``` ## Liberty BASIC As Fortran & PureBasic. ```lb print "MCMXCIX = "; romanDec( "MCMXCIX") '1999 print "MDCLXVI = "; romanDec( "MDCLXVI") '1666 print "XXV = "; romanDec( "XXV") '25 print "CMLIV = "; romanDec( "CMLIV") '954 print "MMXI = "; romanDec( "MMXI") '2011 end function romanDec( roman$) arabic =0 lastval =0 for i = len( roman$) to 1 step -1 select case upper$( 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 case else n = 0 end select if n current_value = { M:1000 D:500 C:100 L:50 X:10 V:5 I:1 }[ch] ? 0 op = if last_value < current_value then (-) else (+) [op(acc, last_value), current_value] # fold the string and sum the resulting tuple (array) fold(_convert, [0, 0]) >> sum {[rom, decimal_of_roman rom] for rom in <[ MCMXC MMVII MDCLXVII MMMCLIX MCMLXXVII MMX ]>} ``` Output: ```txt {"MCMXC":1990,"MMVII":2007,"MDCLXVII":1667,"MMMCLIX":3159,"MCMLXXVII":1977,"MMX":2010} ``` ## Logo ```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 ``` {{out}} ```txt MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008 ``` ## Lua ```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" ) ) ``` ```txt 1990 2008 1666 ``` ## M2000 Interpreter Maximum Roman number is MMMCMXCIX (3999) ```M2000 Interpreter Module RomanNumbers { flush ' empty current stack gosub Initialize document Doc$ while not empty read rom$ print rom$;"=";RomanEval$(rom$) Doc$=rom$+"="+RomanEval$(rom$)+{ } end while Clipboard Doc$ end Initialize: function RomanEval$(rom$) { Flush ="invalid" if filter$(rom$,"MDCLXVI")<>"" Then Exit \\ "Y" is in top of stack Push "CM", "MD", "Q" Push "CD", "MD","W" Push "XC", "DL", "E" Push "XL", "X","R" Push "IX","V","T" Push "IV","I","Y" \\ stack flush to doublerom doublerom=[] \\ "M" is in top of stack Data "M", 1000, "Q",900 Data "D", 500,"W", 400 Data "C",100,"E",90 Data "L",50,"R", 40 Data "X", 10, "T", 9 Data "V", 5, "Y", 4, "I",1 \\ stack flush to singlerom singlerom=[] acc=0 value=0 count=0 stack doublerom { if empty then exit read rep$,exclude$,cc$ i=instr(rom$,cc$) if i >0 then tmp$=mid$(rom$,i+2) L=Len(tmp$) if L>0 then if Len(filter$(tmp$, exclude$))<>L then rom$="A": exit if Instr(rom$,mid$(rom$,i,1))3 then exit loop } if len(rom$)>0 or count>3 Else =Str$(acc,1033) end if } data "MMMCMXCIX", "LXXIIX", "MMXVII", "LXXIX", "CXCIX","MCMXCIX","MMMDCCCLXXXVIII" data "CMXI","M","MCDXLIV","CCCC","IXV", "XLIXL","LXXIIX","IVM" data "XXXIX", "XXXX", "XIXX","IVI", "XLIX","XCIX","XCIV","XLVIII" return } RomanNumbers ``` {{out}}
MMMCMXCIX=3999
LXXIIX=invalid
MMXVII=2017
LXXIX=79
CXCIX=199
MCMXCIX=1999
MMMDCCCLXXXVIII=3888
CMXI=911
M=1000
MCDXLIV=1444
CCCC=invalid
IXV=invalid
XLIXL=invalid
LXXIIX=invalid
IVM=invalid
XXXIX=39
XXXX=invalid
XIXX=invalid
IVI=invalid
XLIX=49
XCIX=99
XCIV=94
XLVIII=48

## Maple ```maple f := n -> convert(n, arabic): seq(printf("%a\n", f(i)), i in [MCMXC, MMVIII, MDCLXVI]); ``` {{out}} ```txt 1990 2008 1666 ``` ## Mathematica ```Mathematica FromRomanNumeral["MMCDV"] ``` returns 2405 ## MATLAB ```Matlab function x = rom2dec(s) % ROM2DEC converts Roman numbers to decimal % store Roman digits values: I=1, V=5, X=10, L=50, C=100, D=500, M=1000 digitsValues = [0 0 100 500 0 0 0 0 1 0 0 50 1000 0 0 0 0 0 0 0 0 5 0 10 0 0]; % convert Roman number to array of values values = digitsValues(s-'A'+1); % change sign if next value is bigger x = sum(values .* [sign(diff(-values)+eps),1]); end ``` Here is a test: ```Matlab romanNumbers = {'MMMCMXCIX', 'XLVIII', 'MMVIII'}; for n = 1 : numel(romanNumbers) fprintf('%10s = %4d\n',romanNumbers{n}, rom2dec(romanNumbers{n})); end ``` {{out}} ```txt MMMCMXCIX = 3999 XLVIII = 48 MMVIII = 2008 ``` ## Mercury ```Mercury :- module test_roman. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module char. :- import_module exception. :- import_module int. :- import_module list. :- import_module string. :- type conversion_error ---> not_a_roman_number. :- func build_int(list(char), int, int) = int. :- func from_roman(string) = int. :- pred roman_to_int(char::in, int::out) is semidet. from_roman(Roman) = Decimal :- List = reverse(to_char_list(Roman)), Decimal = build_int(List, 0, 0). build_int([], LastValue, Accumulator) = LastValue + Accumulator. build_int([Digit|Rest], LastValue, Accumulator) = Sum :- ( roman_to_int(Digit, Value) -> ( Value < LastValue -> Sum = build_int(Rest, Value, Accumulator - LastValue) ; Sum = build_int(Rest, Value, Accumulator + LastValue) ) ; throw(not_a_roman_number) ). roman_to_int('I', 1). roman_to_int('V', 5). roman_to_int('X', 10). roman_to_int('L', 50). roman_to_int('C', 100). roman_to_int('D', 500). roman_to_int('M', 1000). main(!IO) :- command_line_arguments(Args, !IO), foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :- format("%s => %d\n", [s(Arg), i(from_roman(Arg))], !IO)), Args, !IO). :- end_module test_roman. ``` ## NetRexx ```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 ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 ``` ## Nim {{trans|Python}} ```nim import tables let rdecode = {'M': 1000, 'D': 500, 'C': 100, 'L': 50, 'X': 10, 'V': 5, 'I': 1}.toTable proc decode(roman): int = for i in 0 .. 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"); ;; ``` ### Another implementation Another implementation, a bit more OCaml-esque: no mutable variables, and a recursive function instead of a for loop. {{works with|OCaml|4.03+}} ```ocaml (* Scan the roman number from right to left. *) (* When processing a roman digit, if the previously processed roman digit was * greater than the current one, we must substract the latter from the current * total, otherwise add it. * Example: * - MCMLXX read from right to left is XXLMCM * the sum is 10 + 10 + 50 + 1000 - 100 + 1000 *) let decimal_of_roman roman = (* Use 'String.uppercase' for OCaml 4.02 and previous. *) let rom = String.uppercase_ascii roman in (* A simple association list. IMHO a Hashtbl is a bit overkill here. *) let romans = List.combine ['I'; 'V'; 'X'; 'L'; 'C'; 'D'; 'M'] [1; 5; 10; 50; 100; 500; 1000] in let compare x y = if x < y then -1 else 1 in (* Scan the string from right to left using index i, and keeping track of * the previously processed roman digit in prevdig. *) let rec doloop i prevdig = if i < 0 then 0 else try let currdig = List.assoc rom.[i] romans in (currdig * compare currdig prevdig) + doloop (i - 1) currdig with (* Ignore any incorrect roman digit and just process the next one. *) Not_found -> doloop (i - 1) 0 in doloop (String.length rom - 1) 0 (* Some simple tests. *) let () = let testit roman decimal = let conv = decimal_of_roman roman in let status = if conv = decimal then "PASS" else "FAIL" in Printf.sprintf "[%s] %s\tgives %d.\tExpected: %d.\t" status roman conv decimal in print_endline ">>> Usual roman numbers."; print_endline (testit "MCMXC" 1990); print_endline (testit "MMVIII" 2008); print_endline (testit "MDCLXVI" 1666); print_newline (); print_endline ">>> Roman numbers with lower case letters are OK."; print_endline (testit "McmXC" 1990); print_endline (testit "MMviii" 2008); print_endline (testit "mdCLXVI" 1666); print_newline (); print_endline ">>> Incorrect roman digits are ignored."; print_endline (testit "McmFFXC" 1990); print_endline (testit "MMviiiPPPPP" 2008); print_endline (testit "mdCLXVI_WHAT_NOW" 1666); print_endline (testit "2 * PI ^ 2" 1); (* The I in PI... *) print_endline (testit "E = MC^2" 1100) ``` Output: ```txt >>> Usual roman numbers. [PASS] MCMXC gives 1990. Expected: 1990. [PASS] MMVIII gives 2008. Expected: 2008. [PASS] MDCLXVI gives 1666. Expected: 1666. >>> Roman numbers with lower case letters are OK. [PASS] McmXC gives 1990. Expected: 1990. [PASS] MMviii gives 2008. Expected: 2008. [PASS] mdCLXVI gives 1666. Expected: 1666. >>> Incorrect roman digits are ignored. [PASS] McmFFXC gives 1990. Expected: 1990. [PASS] MMviiiPPPPP gives 2008. Expected: 2008. [PASS] mdCLXVI_WHAT_NOW gives 1666. Expected: 1666. [PASS] 2 * PI ^ 2 gives 1. Expected: 1. [PASS] E = MC^2 gives 1100. Expected: 1100. ``` ## PARI/GP ```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 }; ``` ## Perl ```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); ``` {{out}} ```txt MCMXC: 1990 MDCLXVI: 1666 MMVIII: 2008 ``` ### Alternate ```perl #!/usr/bin/perl use strict; use warnings; sub roman2decimal { (local $_, my $sum, my $zeros) = (shift, 0, ''); $zeros .= 0 while $sum -= s/I(?=[VX])// - s/V// * 5 - s/I//g . $zeros, tr/MDCLX/CLXVI/; return $sum; } print s/$/ ": " . roman2decimal($_) /er while ; __DATA__ MCMXC MMVIII MDCLXVI ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 ``` ### Another Alternate ```perl #!/usr/bin/perl use strict; use warnings; sub roman2decimal { my $sum = 0; $sum += $^R while $_[0] =~ / M (?{1000}) | D (?{ 500}) | C (?{ 100}) (?= [MD] (?{-100}) )? | L (?{ 50}) | X (?{ 10}) (?= [CL] (?{ -10}) )? | V (?{ 5}) | I (?{ 1}) (?= [XV] (?{ -1}) )? /gx; return $sum; } print s/$/ ": " . roman2decimal($_) /er while ; __DATA__ MCMXC MMVIII MDCLXVI ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 ``` ## Perl 6 A non-validating version: ```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 ; ``` {{out}} ```txt MCMXC => 1990 MDCLXVI => 1666 MMVIII => 2008 ``` A validating version. Also handles older forms such as 'IIXX' and "IIII". ```perl6 sub rom-to-num($r) { [+] gather $r.uc ~~ / ^ ( (C*)M { take 1000 - 100 * $0.chars } )* ( (C*)D { take 500 - 100 * $0.chars } )? ( (X*)C { take 100 - 10 * $0.chars } )* ( (X*)L { take 50 - 10 * $0.chars } )? ( (I*)X { take 10 - $0.chars } )* ( (I*)V { take 5 - $0.chars } )? ( I { take 1 } )* [ $ || { return NaN } ] /; } say "$_ => ", rom-to-num($_) for ; ``` {{out}} ```txt MCMXC => 1990 mdclxvi => 1666 MMViii => 2008 IIXX => 18 ILL => NaN ``` ## Phix ```Phix constant romans = "MDCLXVI", decmls = {1000,500,100,50,10,5,1} function romanDec(string s) integer n, prev = 0, res = 0 for i=length(s) to 1 by -1 do n = decmls[find(s[i],romans)] if n= A B) A (- A))) L (cdr L)) ) ) ``` Test: ```txt : (roman2decimal "MCMXC") -> 1990 : (roman2decimal "MMVIII") -> 2008 : (roman2decimal "MDCLXVI") -> 1666 ``` ## PHP ```PHP 1, 'V' => 5, 'X' => 10, 'L' => 50, 'C' => 100, 'D' => 500, 'M' => 1000, ); /** * @param $number * @return int */ function roman2decimal($number) { global $roman_to_decimal; // breaks the string into an array of chars $digits = str_split($number); $lastIndex = count($digits)-1; $sum = 0; foreach($digits as $index => $digit) { if(!isset($digits[$index])) { continue; } if(isset($roman_to_decimal[$digit])) { if($index < $lastIndex) { $left = $roman_to_decimal[$digits[$index]]; $right = $roman_to_decimal[$digits[$index+1]]; if($left < $right) { $sum += ($right - $left); unset($digits[$index+1],$left, $right); continue; } unset($left, $right); } } $sum += $roman_to_decimal[$digit]; } return $sum; } /* ### ========== OUTPUT ========== */ header('Content-Type: text/plain'); $tests = array( "I" => array(roman2decimal('I'), 1), "II" => array(roman2decimal('II'), 2), "III" => array(roman2decimal('III'), 3), "IV" => array(roman2decimal('IV'), 4), "V" => array(roman2decimal('V'), 5), "VI" => array(roman2decimal('VI'), 6), "VII" => array(roman2decimal('VII'), 7), "IX" => array(roman2decimal('IX'), 9), "X" => array(roman2decimal('X'), 10), "XI" => array(roman2decimal('XI'), 11), "XIV" => array(roman2decimal('XIV'), 14), "XV" => array(roman2decimal('XV'), 15), "XVI" => array(roman2decimal('XVI'), 16), "XVIV" => array(roman2decimal('XVIV'), 19), "XIX" => array(roman2decimal('XIX'), 19), "MDCLXVI" => array(roman2decimal('MDCLXVI'), 1666), "MCMXC" => array(roman2decimal('MCMXC'), 1990), "MMVIII" => array(roman2decimal('MMVIII'), 2008), "MMMCLIX" => array(roman2decimal('MMMCLIX'), 3159), "MCMLXXVII" => array(roman2decimal('MCMLXXVII'), 1977), ); foreach($tests as $key => $value) { echo "($key == {$value[0]}) => " . ($value[0] === $value[1] ? "true" : "false, should be {$value[1]}.") . "\n"; } ``` {{out}} ```txt (I == 1) => true (II == 2) => true (III == 3) => true (IV == 4) => true (V == 5) => true (VI == 6) => true (VII == 7) => true (IX == 9) => true (X == 10) => true (XI == 11) => true (XIV == 14) => true (XV == 15) => true (XVI == 16) => true (XVIV == 19) => true (XIX == 19) => true (MDCLXVI == 1666) => true (MCMXC == 1990) => true (MMVIII == 2008) => true (MMMCLIX == 3159) => true (MCMLXXVII == 1977) => true ``` ## PL/I ```PL/I test_decode: procedure options (main); /* 28 January 2013 */ declare roman character (20) varying; do roman = 'i', 'ii', 'iii', 'iv', 'v', 'vi', 'vii', 'viii', 'iix', 'ix', 'x', 'xi', 'xiv', 'MCMLXIV', 'MCMXC', 'MDCLXVI', 'MIM', 'MM', 'MMXIII'; put skip list (roman, decode(roman)); end; decode: procedure (roman) returns (fixed(15)); declare roman character (*) varying; declare (current, previous) character (1); declare n fixed (15); declare i fixed binary; previous = ''; n = 0; do i = length(roman) to 1 by -1; current = substr(roman, i, 1); if digit_value(current) < digit_value(previous) then n = n - digit_value(current); else if digit_value(current) > digit_value(previous) then do; n = n + digit_value(current); previous = current; end; else n = n + digit_value(current); end; return (n); end decode; digit_value: procedure (roman_char) returns (fixed); declare roman_char character(1); select (roman_char); 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); otherwise return (0); end; end digit_value; end test_decode; ``` ```txt i 1 ii 2 iii 3 iv 4 v 5 vi 6 vii 7 viii 8 iix 8 ix 9 x 10 xi 11 xiv 14 MCMLXIV 1964 MCMXC 1990 MDCLXVI 1666 MIM 1999 MM 2000 MMXIII 2013 ``` ## PL/SQL ```PL/SQL /***************************************************************** * $Author: Atanas Kebedjiev $ ***************************************************************** * PL/SQL code can be run as anonymous block. * To test, execute the whole script or create the functions and then e.g. 'select rdecode('2012') from dual; * Please note that task definition does not describe fully some current rules, such as * * subtraction - IX XC CM are the valid subtraction combinations * * A subtraction character cannot be repeated: 8 is expressed as VIII and not as IIX * * V L and D cannot be used for subtraction * * Any numeral cannot be repeated more than 3 times: 1910 should be MCMX and not MDCCCCX * Code below does not validate the Roman numeral itself and will return a result even for a non-compliant number * E.g. both MCMXCIX and IMM will return 1999 but the first one is the correct notation */ DECLARE FUNCTION rvalue(c IN CHAR) RETURN NUMBER IS i INTEGER; BEGIN i := 0; CASE (c) when 'M' THEN i := 1000; when 'D' THEN i := 500; when 'C' THEN i := 100; when 'L' THEN i := 50; when 'X' THEN i := 10; when 'V' THEN i := 5; when 'I' THEN i := 1; END CASE; RETURN i; END; FUNCTION decode(rn IN VARCHAR2) RETURN NUMBER IS i INTEGER; l INTEGER; cr CHAR; -- current Roman numeral as substring from r cv INTEGER; -- value of current Roman numeral gr CHAR; -- next Roman numeral gv NUMBER; -- value of the next numeral; dv NUMBER; -- decimal value to return BEGIN l := length(rn); i := 1; dv := 0; while (i <= l) LOOP cr := substr(rn,i,1); cv := rvalue(cr); /* Look for a larger numeral in next position, like IV or CM The number to subtract should be at least 1/10th of the bigger number CM and XC are valid, but IC and XM are not */ IF (i < l) THEN gr := substr(rn,i+1,1); gv := rvalue(gr); IF (cv < gv ) THEN dv := dv - cv; ELSE dv := dv + cv; END IF; ELSE dv := dv + cv; END IF; -- need to add the last value unconditionally i := i + 1; END LOOP; RETURN dv; END; BEGIN DBMS_OUTPUT.PUT_LINE ('MMXII = ' || rdecode('MMXII')); -- 2012 DBMS_OUTPUT.PUT_LINE ('MCMLI = ' || rdecode('MCMLI')); -- 1951 DBMS_OUTPUT.PUT_LINE ('MCMLXXXVII = ' || rdecode('MCMLXXXVII')); -- 1987 DBMS_OUTPUT.PUT_LINE ('MDCLXVI = ' || rdecode('MDCLXVI')); -- 1666 DBMS_OUTPUT.PUT_LINE ('MCMXCIX = ' || rdecode('MCMXCIX')); -- 1999 END; ``` ## PowerShell ```PowerShell function ConvertFrom-RomanNumeral { <# .SYNOPSIS Converts a roman numeral to a number. .DESCRIPTION Converts a roman numeral - in the range of I..MMMCMXCIX - to a number. .PARAMETER Numeral A roman numeral in the range I..MMMCMXCIX (1..3,999). .INPUTS System.String .OUTPUTS System.Int32 .NOTES Requires PowerShell version 3.0 .EXAMPLE ConvertFrom-RomanNumeral -Numeral MMXIV .EXAMPLE "MMXIV" | ConvertFrom-RomanNumeral #> [CmdletBinding()] [OutputType([int])] Param ( [Parameter(Mandatory=$true, HelpMessage="Enter a roman numeral in the range I..MMMCMXCIX", ValueFromPipeline=$true, Position=0)] [ValidatePattern("(?x)^ M{0,3} # Thousands (CM|CD|D?C{0,3}) # Hundreds (XC|XL|L?X{0,3}) # Tens (IX|IV|V?I{0,3}) # Ones $")] [string] $Numeral ) Begin { # This must be an [ordered] hashtable $RomanToDecimal = [ordered]@{ 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 } } Process { $roman = $Numeral + '$' $value = 0 do { foreach ($key in $RomanToDecimal.Keys) { if ($key.Length -eq 1) { if ($key -match $roman.Substring(0,1)) { $value += $RomanToDecimal.$key $roman = $roman.Substring(1) break } } else { if ($key -match $roman.Substring(0,2)) { $value += $RomanToDecimal.$key $roman = $roman.Substring(2) break } } } } until ($roman -eq '$') $value } } ``` ```PowerShell -split "MM MMI MMII MMIII MMIV MMV MMVI MMVII MMVIII MMIX MMX MMXI MMXII MMXIII MMXIV MMXV MMXVI" | ConvertFrom-RomanNumeral ``` {{Out}} ```txt 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 ``` ## Prolog ```Prolog decode_digit(i, 1). decode_digit(v, 5). decode_digit(x, 10). decode_digit(l, 50). decode_digit(c, 100). decode_digit(d, 500). decode_digit(m, 1000). decode_string(Sum, _, [], Sum). decode_string(LastSum, LastValue, [Digit|Rest], NextSum) :- decode_digit(Digit, Value), Value < LastValue, Sum is LastSum - Value, decode_string(Sum, Value, Rest, NextSum). decode_string(LastSum, LastValue, [Digit|Rest], NextSum) :- decode_digit(Digit, Value), Value >= LastValue, Sum is LastSum + Value, decode_string(Sum, Value, Rest, NextSum). decode_string(Atom, Value) :- atom_chars(Atom, String), reverse(String, [Last|Rest]), decode_digit(Last, Start), decode_string(Start, Start, Rest, Value). test :- decode_string(mcmxc, 1990), decode_string(mmviii, 2008), decode_string(mdclxvi, 1666). ``` The program above contains its own test predicate. The respective goal succeeds. Therefore the test passes. ## PureBasic ```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 ``` {{out}} ```txt 1999 1666 25 954 2011 ``` ## Python ### Imperative ```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) ) ``` {{out}} ```txt MCMXC 1990 MMVIII 2008 MDCLXVI 1666 ``` Another version, which I believe has clearer logic: ```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))) ``` {{out}} ```txt MCMXC = 1990 MMVIII = 2008 MDCLXVI = 1666 ``` ### Declarative Less clear, but a 'one liner': ```python numerals = { 'M' : 1000, 'D' : 500, 'C' : 100, 'L' : 50, 'X' : 10, 'V' : 5, 'I' : 1 } def romannumeral2number(s): return reduce(lambda x, y: -x + y if x < y else x + y, map(lambda x: numerals.get(x, 0), s.upper())) ``` Or, defining '''intFromRoman''' as a fold or reduction, and annotating a little more fully: {{Trans|Haskell}} {{Works with|Python|3}} ```python '''Roman numerals decoded''' from operator import mul from functools import reduce from collections import defaultdict from itertools import accumulate, chain, cycle # intFromRoman :: String -> Maybe Int def intFromRoman(s): '''Just the integer represented by a Roman numeral string, or Nothing if any characters are unrecognised. ''' def go(mb, x): '''Just a letter value added to or subtracted from a total, or Nothing if no letter value is defined. ''' if mb.get('Nothing') or None is x: return Nothing() else: r, total = mb.get('Just') return Just(( x, total + (-x if x < r else x) )) dct = defaultdict( lambda: None, zip( 'IVXLCDM', accumulate(chain([1], cycle([5, 2])), mul) ) ) return bindMay( reduce( go, [dct[k.upper()] for k in reversed(list(s))], Just((0, 0)) ) )(compose(Just)(snd)) # TEST ---------------------------------------------------- def main(): '''Testing a sample of dates.''' print( fTable(__doc__ + ':\n')(str)( maybe('(Contains unknown character)')(str) )( intFromRoman )([ "MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVIII", "MMZZIII" ]) ) # GENERIC ------------------------------------------------- # Just :: a -> Maybe a def Just(x): '''Constructor for an inhabited Maybe (option type) value.''' return {'type': 'Maybe', 'Nothing': False, 'Just': x} # Nothing :: Maybe a def Nothing(): '''Constructor for an empty Maybe (option type) value.''' return {'type': 'Maybe', 'Nothing': True} # bindMay (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b def bindMay(m): '''Injection operator for the Maybe monad. If m is Nothing, it is passed straight through. If m is Just(x), the result is an application of the (a -> Maybe b) function (mf) to x.''' return lambda mf: ( m if m.get('Nothing') else mf(m.get('Just')) ) # compose (<<<) :: (b -> c) -> (a -> b) -> a -> c def compose(g): '''Right to left function composition.''' return lambda f: lambda x: g(f(x)) # maybe :: b -> (a -> b) -> Maybe a -> b def maybe(v): '''Either the default value v, if m is Nothing, or the application of f to x, where m is Just(x). ''' return lambda f: lambda m: v if m.get('Nothing') else ( f(m.get('Just')) ) # snd :: (a, b) -> b def snd(tpl): '''Second member of a pair.''' return tpl[1] # FORMATTING ---------------------------------------------- # fTable :: String -> (a -> String) -> # (b -> String) -> (a -> b) -> [a] -> String def fTable(s): '''Heading -> x display function -> fx display function -> f -> xs -> tabular string. ''' def go(xShow, fxShow, f, xs): ys = [xShow(x) for x in xs] w = max(map(len, ys)) return s + '\n' + '\n'.join(map( lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)), xs, ys )) return lambda xShow: lambda fxShow: lambda f: lambda xs: go( xShow, fxShow, f, xs ) # MAIN --- if __name__ == '__main__': main() ``` {{Out}} ```txt Roman numerals decoded: MDCLXVI -> 1666 MCMXC -> 1990 MMVIII -> 2008 MMXVI -> 2016 MMXVIII -> 2018 MMZZIII -> (Contains unknown character) ``` ## Racket ```Racket #lang racket (define (decode/roman number) (define letter-values (map cons '(#\M #\D #\C #\L #\X #\V #\I) '(1000 500 100 50 10 5 1))) (define (get-value letter) (cdr (assq letter letter-values))) (define lst (map get-value (string->list number))) (+ (last lst) (for/fold ((sum 0)) ((i (in-list lst)) (i+1 (in-list (cdr lst)))) (+ sum (if (> i+1 i) (- i) i))))) (map decode/roman '("MCMXC" "MMVIII" "MDCLXVI")) ;-> '(1990 2008 1666) ``` ## R ### version 1 Modelled along the lines of other decode routines on this page, but using a vectorised approach ```R romanToArabic <- function(roman) { romanLookup <- c(I=1L, V=5L, X=10L, L=50L, C=100L, D=500L, M=1000L) rSplit <- strsplit(toupper(roman), character(0)) # Split input vector into characters toArabic <- function(item) { digits <- romanLookup[item] if (length(digits) > 1L) { smaller <- (digits[-length(digits)] < digits[-1L]) digits[smaller] <- - digits[smaller] } sum(digits) } vapply(rSplit, toArabic, integer(1)) } ``` Example usage: ```R romanToArabic(c("MCMXII", "LXXXVI")) ``` ### version 2 Using built-in functionality in R ```R as.integer(as.roman(c("MCMXII", "LXXXVI")) ``` ## Red ### version 1 ```Red Red [ Purpose: "Arabic <-> Roman numbers converter" Author: "Didier Cadieu" Date: "07-Oct-2016" ] table-r2a: reverse [1000 "M" 900 "CM" 500 "D" 400 "CD" 100 "C" 90 "XC" 50 "L" 40 "XL" 10 "X" 9 "IX" 5 "V" 4 "IV" 1 "I"] roman-to-arabic: func [r [string!] /local a b e] [ a: 0 parse r [any [b: ["I" ["V" | "X" | none] | "X" ["L" | "C" | none] | "C" ["D" | "M" | none] | "V" | "L" | "D" | "M"] e: (a: a + select table-r2a copy/part b e)]] a ] ; Example usage: print roman-to-arabic "XXXIII" print roman-to-arabic "MDCCCLXXXVIII" print roman-to-arabic "MMXVI" ``` ## REXX ### version 1 {{Trans|NetRexx}} {{Works with|Regina}} {{Works with|ooRexx}} ```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 ``` {{out}} ```txt MCMXC: 1990 MMVIII: 2008 MDCLXVI: 1666 ``` ### version 2 This version of the (above) REXX program: :::* removes 3 sets of superfluous '''do──end''' statements :::* removes dead code (3 REXX statements that can't be executed) :::* replaced '''substr(xxx, length(xxx), 1)''' with '''right(xxx,1)''' :::* removes a useless '''parse''' statement :::* compresses '''63''' lines to '''29''' lines :::* reordered '''if''' statements by most likely to occur This REXX version '''won't''' handle: :::* Roman numbers like '''IIXX''' :::* the '''j''' and '''u''' numerals :::* (deep) parenthesis type Roman numbers ```rexx /*REXX program converts Roman numeral number(s) ───► Arabic numerals (or numbers). */ rYear = 'MCMXC' ; say right(rYear, 9)":" rom2dec(rYear) rYear = 'mmviii' ; say right(rYear, 9)":" rom2dec(rYear) rYear = 'MDCLXVI' ; say right(rYear, 9)":" rom2dec(rYear) exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ rom2dec: procedure; arg roman . /*obtain the Roman numeral number. */ if verify(roman, 'MDCLXVI')\==0 then return "***error*** invalid Roman number:" roman #=rChar(right(roman, 1)) /*start with the last Roman numeral. */ do j=1 for length(roman) - 1 x=rChar( substr(roman, j , 1) ) /*extract the current Roman numeral. */ y=rChar( substr(roman, j+1, 1) ) /*extract the next Roman numeral. */ if xh then h=_ /*remember Roman numeral.*/ if _next? Then sub. */ else #=#+_ /* else add. */ end /*k*/ return # /*return Arabic number. */ ``` '''output''' when using the default inputs: ```txt MCMXC: 1990 mmviii: 2008 IIXX: 18 LU: 55 MDCLXVI: 1666 MDWLXVI: ***error*** invalid Roman numeral: W ((mmm)): 3000000000 [[[[[D]]]]]: 500000000000000000 ``` ## Ring ```ring symbols = "MDCLXVI" weights = [1000,500,100,50,10,5,1] see "MCMXCIX = " + romanDec("MCMXCIX") + nl see "MDCLXVI =" + romanDec("MDCLXVI") + nl see "XXV = " + romanDec("XXV") + nl see "CMLIV = " + romanDec("CMLIV") + nl see "MMXI = " + romanDec("MMXI") + nl func romanDec roman n = 0 lastval = 0 arabic = 0 for i = len(roman) to 1 step -1 n = substr(symbols,roman[i]) if n > 0 n = weights[n] ok if n < lastval arabic = arabic - n else arabic = arabic + n ok lastval = n next return arabic ``` ## Ruby ```ruby def fromRoman(roman) r = roman.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.slice!(0,len) end n end [ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| p r => fromRoman(r)} ``` {{out}} ```txt {"MCMXC"=>1990} {"MMVIII"=>2008} {"MDCLXVI"=>1666} ``` or ```ruby SYMBOLS = [ ['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] ] def parseRoman(roman) r = roman.upcase n = 0 SYMBOLS.each { |sym, val| n += val while r.sub!(/^#{sym}/, "") } n end [ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| puts "%8s :%5d" % [r, parseRoman(r)]} ``` {{out}} ```txt MCMXC : 1990 MMVIII : 2008 MDCLXVI : 1666 ``` ## Run BASIC ```runbasic print "MCMXCIX = "; romToDec( "MCMXCIX") '1999 print "MDCLXVI = "; romToDec( "MDCLXVI") '1666 print "XXV = "; romToDec( "XXV") '25 print "CMLIV = "; romToDec( "CMLIV") '954 print "MMXI = "; romToDec( "MMXI") '2011 function romToDec(roman$) for i = len(roman$) to 1 step -1 x$ = mid$(roman$, i, 1) n = 0 if x$ = "M" then n = 1000 if x$ = "D" then n = 500 if x$ = "C" then n = 100 if x$ = "L" then n = 50 if x$ = "X" then n = 10 if x$ = "V" then n = 5 if x$ = "I" then n = 1 if n < preNum then num = num - n else num = num + n preNum = n next romToDec =num end function ``` ## Rust ```rust struct RomanNumeral { symbol: &'static str, value: u32 } const NUMERALS: [RomanNumeral; 13] = [ RomanNumeral {symbol: "M", value: 1000}, RomanNumeral {symbol: "CM", value: 900}, RomanNumeral {symbol: "D", value: 500}, RomanNumeral {symbol: "CD", value: 400}, RomanNumeral {symbol: "C", value: 100}, RomanNumeral {symbol: "XC", value: 90}, RomanNumeral {symbol: "L", value: 50}, RomanNumeral {symbol: "XL", value: 40}, RomanNumeral {symbol: "X", value: 10}, RomanNumeral {symbol: "IX", value: 9}, RomanNumeral {symbol: "V", value: 5}, RomanNumeral {symbol: "IV", value: 4}, RomanNumeral {symbol: "I", value: 1} ]; fn to_hindu(roman: &str) -> u32 { match NUMERALS.iter().find(|num| roman.starts_with(num.symbol)) { Some(num) => num.value + to_hindu(&roman[num.symbol.len()..]), None => 0, // if string empty, add nothing } } fn main() { let roms = ["MMXIV", "MCMXCIX", "XXV", "MDCLXVI", "MMMDCCCLXXXVIII"]; for &r in &roms { // 15 is minimum formatting width of the first argument, there for alignment println!("{:2$} = {}", r, to_hindu(r), 15); } } ``` {{out}} ```txt MMXIV = 2014 MCMXCIX = 1999 XXV = 25 MDCLXVI = 1666 MMMDCCCLXXXVIII = 3888 ``` ## Scala ```Scala def fromRoman( r:String ) : Int = { val arabicNumerals = List("CM"->900,"M"->1000,"CD"->400,"D"->500,"XC"->90,"C"->100, "XL"->40,"L"->50,"IX"->9,"X"->10,"IV"->4,"V"->5,"I"->1) var s = r arabicNumerals.foldLeft(0){ (n,t) => { val l = s.length; s = s.replaceAll(t._1,""); val c = (l - s.length)/t._1.length // Get the frequency n + (c*t._2) // Add the arabic numerals up } } } // Here is a another version that does a simple running sum: def fromRoman2(s: String) : Int = { val numerals = Map('I' -> 1, 'V' -> 5, 'X' -> 10, 'L' -> 50, 'C' -> 100, 'D' -> 500, 'M' -> 1000) s.toUpperCase.map(numerals).foldLeft((0,0)) { case ((sum, last), curr) => (sum + curr + (if (last < curr) -2*last else 0), curr) }._1 } } // A small test def test( roman:String ) = println( roman + " => " + fromRoman( roman ) ) test("MCMXC") test("MMVIII") test("MDCLXVI") ``` {{out}} ```txt MCMXC => 1990 MMVIII => 2008 MDCLXVI => 1666 ``` ## Scheme {{works with|Gauche Scheme}} ```Scheme (use gauche.collection) ;; for fold2 (define (char-val char) (define i (string-scan "IVXLCDM" char)) (* (expt 10 (div i 2)) (expt 5 (mod i 2)))) (define (decode roman) (fold2 (lambda (n sum prev-val) (values ((if (< n prev-val) - +) sum n) (max n prev-val))) 0 0 (map char-val (reverse (string->list roman))))) ``` Testing: ```Scheme (for-each (^s (format #t "~7d: ~d\n" s (decode s))) '("MCMLVI" "XXC" "MCMXC" "XXCIII" "IIIIX" "MIM" "LXXIIX")) ``` {{out}} ```txt MCMLVI: 1956 XXC: 80 MCMXC: 1990 XXCIII: 83 IIIIX: 6 MIM: 1999 LXXIIX: 78 ``` ## Seed7 ```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; ``` Original source: [http://seed7.sourceforge.net/algorith/puzzles.htm#decode_roman_numerals] {{out}} ```txt 1990 2008 1666 ``` ## Sidef ```ruby func roman2arabic(roman) {   var arabic = 0 var last_digit = 1000   static m = Hash( I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000, )   roman.uc.chars.map{m{_} \\ 0}.each { |digit| if (last_digit < digit) { arabic -= (2 * last_digit) } arabic += (last_digit = digit) }   return arabic }   %w(MCMXC MMVIII MDCLXVI).each { |roman_digit| "%-10s == %d\n".printf(roman_digit, roman2arabic(roman_digit)) } ``` {{out}} ```txt MCMXC == 1990 MMVIII == 2008 MDCLXVI == 1666 ``` Simpler solution: ```ruby func roman2arabic(digit) { digit.uc.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+', ]).split('+').map{.to_i}.sum; }   %w(MCMXC MMVIII MDCLXVI).each { |roman_num| say "#{roman_num}\t-> #{roman2arabic(roman_num)}"; } ``` {{out}} ```txt MCMXC -> 1990 MMVIII -> 2008 MDCLXVI -> 1666 ``` ## Simula ```simula BEGIN INTEGER PROCEDURE FROMROMAN(S); TEXT S; BEGIN PROCEDURE P(INTVAL, NUM); INTEGER INTVAL; TEXT NUM; BEGIN INTEGER NLEN; NLEN := NUM.LENGTH; WHILE INDEX + NLEN - 1 <= SLEN AND THEN S.SUB(INDEX, NLEN) = NUM DO BEGIN RESULT := RESULT + INTVAL; INDEX := INDEX + NLEN; END WHILE; END P; INTEGER RESULT, INDEX, SLEN; SLEN := S.LENGTH; INDEX := 1; P( 1000, "M" ); P( 900, "CM" ); P( 500, "D" ); P( 400, "CD" ); P( 100, "C" ); P( 90, "XC" ); P( 50, "L" ); P( 40, "XL" ); P( 10, "X" ); P( 9, "IX" ); P( 5, "V" ); P( 4, "IV" ); P( 1, "I" ); FROMROMAN := RESULT; END FROMROMAN; TEXT T; FOR T :- "MCMXC", "MMVIII", "MDCLXVI" DO BEGIN OUTTEXT("ROMAN """); OUTTEXT(T); OUTTEXT(""" => "); OUTINT(FROMROMAN(T), 0); OUTIMAGE; END FOR; END PROGRAM; ``` {{out}} ```txt ROMAN "MCMXC" => 1990 ROMAN "MMVIII" => 2008 ROMAN "MDCLXVI" => 1666 ``` ## SPL ```SPL r2a(r)= n = [1,5,10,50,100,500,1000] a,m = 0 > i, #.size(r)..1, -1 v,c = n[#.pos("IVXLCDM",#.mid(r,i))] ? vm, m = c a += v < <= a . t = ["MMXI","MIM","MCMLVI","MDCLXVI","XXCIII","LXXIIX","IIIIX"] > i, 1..#.size(t,1) #.output(t[i]," = ",r2a(t[i])) < ``` {{out}} ```txt MMXI = 2011 MIM = 1999 MCMLVI = 1956 MDCLXVI = 1666 XXCIII = 83 LXXIIX = 78 IIIIX = 6 ``` ## TechBASIC ```techBASIC Main: !------------------------------------------------ ! CALLS THE romToDec FUNCTION WITH THE ROMAN ! NUMERALS AND RETURNS ITS DECIMAL EQUIVELENT. ! PRINT "MCMXC = "; romToDec("MCMXC") !1990 PRINT "MMVIII = "; romToDec("MMVIII") !2008 PRINT "MDCLXVI = "; romToDec("MDCLXVI") !1666 PRINT:PRINT PRINT "Here are other solutions not from the TASK:" PRINT "MCMXCIX = "; romToDec("MCMXCIX") !1999 PRINT "XXV = "; romToDec("XXV") !25 PRINT "CMLIV = "; romToDec("CMLIV") !954 PRINT "MMXI = "; romToDec("MMXI") !2011 PRINT:PRINT PRINT "Without error checking, this also is 2011, but is wrong" PRINT "MMIIIX = "; romToDec("MMIIIX") !INVAID, 2011 STOP FUNCTION romToDec(roman AS STRING) AS INTEGER !------------------------------------------------------ ! FUNCTION THAT CONVERTS ANY ROMAN NUMERAL TO A DECIMAL ! prenum=0!num=0 ln=LEN(roman) FOR i=ln TO 1 STEP -1 x$=MID(roman,i,1) n=1000 SELECT CASE x$ CASE "M":n=n/1 CASE "D":n=n/2 CASE "C":n=n/10 CASE "L":n=n/20 CASE "X":n=n/100 CASE "V":n=n/200 CASE "I":n=n/n CASE ELSE:n=0 END SELECT IF n < preNum THEN num=num-n ELSE num=num+n preNum=n next i romToDec=num END FUNCTION ``` {{out}} ```txt MCMXC = 1990 MMVIII = 2008 MDCLXVI = 1666 Here are other solutions not from the TASK: MCMXCIX = 1999 XXV = 25 CMLIV = 954 MMXI = 2011 Without error checking, this also is 2011, but is wrong MMIIIX = 2011 ``` ## SNOBOL4 ```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 ``` {{out}} ```txt 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: ```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 ``` 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. ```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 ``` ## Swift ```swift extension Int { init(romanNumerals: String) { let 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), ] self = 0 var raw = romanNumerals for (digit, value) in values { while raw.hasPrefix(digit) { self += value raw.removeFirst(digit.count) } } } } ``` {{output}} ```swift Int(romanNumerals: "MDCLXVI") // 1666 ``` ## 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: ```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} } ``` Demonstrating: ```tcl foreach r {MCMXC MDCLXVI MMVIII} { puts "$r\t-> [fromRoman $r]" } ``` {{out}} ```txt MCMXC -> 1990 MDCLXVI -> 1666 MMVIII -> 2008 ``` =={{header|TI-83 BASIC}}== Using the Rom‣Dec function "real(21," from [http://www.detachedsolutions.com/omnicalc/ Omnicalc]. ```ti83b PROGRAM:ROM2DEC :Input Str1 :Disp real(21,Str1) ``` Using TI-83 BASIC ```ti83b PROGRAM:ROM2DEC :Input "ROMAN:",Str1 :{1000,500,100,50,10,5,1}➞L1 :0➞P :0➞Y :For(I,length(Str1),1,-1) :inString("MDCLXVI",sub(Str1,I,1))➞X :If X≤0:Then :Disp "BAD NUMBER" :Stop :End :L1(x)➞N :If N=0;i--)) do case "${rnum:$i:1}" in M) a=1000 ;; D) a=500 ;; C) a=100 ;; L) a=50 ;; X) a=10 ;; V) a=5 ;; I) a=1 ;; esac if [[ $a -lt $prev ]] then let n-=a else let n+=a fi prev=$a done echo "$rnum = $n" } roman_to_dec MCMXC roman_to_dec MMVIII roman_to_dec MDCLXVI ``` ## VBA Convert Romans (i.e : XVI) in integers ```vb Option Explicit Sub Main_Romans_Decode() Dim Arr(), i& Arr = Array("III", "XXX", "CCC", "MMM", "VII", "LXVI", "CL", "MCC", "IV", "IX", "XC", "ICM", "DCCCXCIX", "CMI", "CIM", "MDCLXVI", "MCMXC", "MMXVII") For i = 0 To UBound(Arr) Debug.Print Arr(i) & " >>> " & lngConvert(CStr(Arr(i))) Next End Sub Function Convert(Letter As String) As Long Dim Romans(), DecInt(), Pos As Integer Romans = Array("M", "D", "C", "L", "X", "V", "I") DecInt = Array(1000, 500, 100, 50, 10, 5, 1) Pos = -1 On Error Resume Next Pos = Application.Match(Letter, Romans, 0) - 1 On Error GoTo 0 If Pos <> -1 Then Convert = DecInt(Pos) End Function Function lngConvert(strRom As String) 'recursive function Dim i As Long, iVal As Integer If Len(strRom) = 1 Then lngConvert = Convert(strRom) Else iVal = Convert(Mid(strRom, 1, 1)) If iVal < Convert(Mid(strRom, 2, 1)) Then iVal = iVal * (-1) lngConvert = iVal + lngConvert(Mid(strRom, 2, Len(strRom) - 1)) End If End Function ``` {{out}} ```txt III >>> 3 XXX >>> 30 CCC >>> 300 MMM >>> 3000 VII >>> 7 LXVI >>> 66 CL >>> 150 MCC >>> 1200 IV >>> 4 IX >>> 9 XC >>> 90 ICM >>> 899 DCCCXCIX >>> 899 CMI >>> 901 CIM >>> 1099 MDCLXVI >>> 1666 MCMXC >>> 1990 MMXVII >>> 2017 ``` ## VBScript {{trans|360 Assembly}} ```vb ' Roman numerals Encode - Visual Basic - 18/04/2019 Function toRoman(ByVal value) Dim arabic Dim roman Dim i, result arabic = Array(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1) roman = Array("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I") For i = 0 To 12 Do While value >= arabic(i) result = result + roman(i) value = value - arabic(i) Loop Next 'i toRoman = result End Function 'toRoman n=InputBox("Number, please","Roman numerals/Encode") code=MsgBox(n & vbCrlf & toRoman(n),vbOKOnly+vbExclamation,"Roman numerals/Encode") If code=vbOK Then ok=1 ``` {{out}} ```txt III >>> 3 XXX >>> 30 CCC >>> 300 MMM >>> 3000 VII >>> 7 LXVI >>> 66 CL >>> 150 MCC >>> 1200 IV >>> 4 IX >>> 9 XC >>> 90 ICM >>> 901 DCCCXCIX >>> 899 CMI >>> 901 CIM >>> 1099 MDCLXVI >>> 1666 MCMXC >>> 1990 MMXVII >>> 2017 I >>> 1 XIV >>> 14 MMMDCCCLXXXVIII >>> 3888 MMMCMXCIX >>> 3999 ``` ## zsh ```zsh #!/bin/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 } parseroman MCMXC parseroman MMVIII parseroman MDCLXVI ``` ## Vedit macro language ```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 ``` {{out}} ```txt iv = 4 xii = 12 MDCLXVI = 1666 MCMXC = 1990 MMXI = 2011 ``` ## XLISP Uses basic list processing and recursion. Probably not amazingly fast, but quite concise and hopefully clear. ```lisp (defun decode (r) (define roman '((#\m 1000) (#\d 500) (#\c 100) (#\l 50) (#\x 10) (#\v 5) (#\i 1))) (defun to-arabic (rn rs a) (cond ((null rn) a) ((eqv? (car rn) (caar rs)) (to-arabic (cdr rn) roman (if (and (not (eqv? (car rn) (cadr rn))) (< (cadar rs) (to-arabic (cdr rn) roman 0))) (- a (cadar rs)) (+ a (cadar rs)) ) ) ) (t (to-arabic rn (cdr rs) a)) ) ) (to-arabic (string->list r) roman 0) ) ``` Test it in a REPL: ```lisp [1] (mapcar decode '("mcmxc" "mmviii" "mdclxvi")) (1990 2008 1666) ``` ## XPL0 ```XPL0 string 0; \use zero-terminated strings code CrLf=9, IntOut=11; func Roman(Str); \Convert Roman numeral string to decimal value char Str; int I, Val, Val0, Sum; [I:= 0; Sum:= 0; Val0:= 5000; loop [case Str(I) of ^M: Val:= 1000; ^D: Val:= 500; ^C: Val:= 100; ^L: Val:= 50; ^X: Val:= 10; ^V: Val:= 5; ^I: Val:= 1 other return Sum; \zero string terminator I:= I+1; Sum:= Sum + Val; if Val > Val0 then Sum:= Sum - 2*Val0; Val0:= Val; ]; ]; [IntOut(0, Roman("MCMXC")); CrLf(0); IntOut(0, Roman("MMVIII")); CrLf(0); IntOut(0, Roman("MDCLXVI")); CrLf(0); ] ``` {{out}} ```txt 1990 2008 1666 ``` ## Yabasic ```Yabasic romans$ = "MDCLXVI" decmls$ = "1000,500,100,50,10,5,1" sub romanDec(s$) local i, n, prev, res, decmls$(1) n = token(decmls$, decmls$(), ",") for i = len(s$) to 1 step -1 n = val(decmls$(instr(romans$, mid$(s$, i, 1)))) if n < prev n = 0 - n res = res + n prev = n next i return res end sub ? romanDec("MCMXCIX") // 1999 ? romanDec("MDCLXVI") // 1666 ? romanDec("XXV") // 25 ? romanDec("XIX") // 19 ? romanDec("XI") // 11 ? romanDec("CMLIV") // 954 ? romanDec("MMXI") // 2011 ? romanDec("CD") // 400 ? romanDec("MCMXC") // 1990 ? romanDec("MMVIII") // 2008 ? romanDec("MMIX") // 2009 ? romanDec("MDCLXVI") // 1666 ? romanDec("MMMDCCCLXXXVIII") // 3888 ``` ## zkl ```zkl var romans = L( L("M", 1000), L("CM", 900), L("D", 500), L("CD", 400), L("C", 100), L("XC", 90), L("L", 50), L("XL", 40), L("X", 10), L("IX", 9), L("V", 5), L("IV", 4), L("I", 1)); fcn toArabic(romanNumber){ // romanNumber needs to be upper case if (not RegExp("^[CDILMVX]+$").matches(romanNumber)) throw(Exception.ValueError("Not a Roman number: %s".fmt(romanNumber))); reg value = 0; foreach R,N in (romans){ while (0 == romanNumber.find(R)){ value += N; romanNumber = romanNumber[R.len(),*]; } } return(value); } ``` ```txt toArabic("MCMXC") //-->1990 toArabic("MMVIII") //-->2008 toArabic("MDCLXVI") //-->1666 ``` {{omit from|GUISS}}