Roman numerals/Decode: Difference between revisions
Add a declarative way of achieving the transformation
(→Haskell mapAccumR: variant) |
(Add a declarative way of achieving the transformation) |
||
| (141 intermediate revisions by 50 users not shown) | |||
Line 14:
The Roman numeral for '''1666''', '''MDCLXVI''', uses each letter in descending order.
<br><br>
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">V 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)]
F roman_value(=roman)
V total = 0
L(symbol, value) reversed(:roman_values)
L roman.starts_with(symbol)
total += value
roman = roman[symbol.len..]
R total
L(value) [‘MCMXC’, ‘MMVIII’, ‘MDCLXVI’]
print(value‘ = ’roman_value(value))</syntaxhighlight>
{{out}}
<pre>
MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
</pre>
=={{header|360 Assembly}}==
<syntaxhighlight lang="360asm">* 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 </syntaxhighlight>
{{out}}
<pre>
XIV -> 14
CMI -> 901
MIC -> 1099
MCMXC -> 1990
MDCLXVI -> 1666
MMVIII -> 2008
MMXIX -> 2019
MMMCMXCV -> 3995
</pre>
=={{header|8080 Assembly}}==
The routine at <code>roman</code> takes the address of a zero-terminated string in BC,
and returns the value of the Roman number in that string as a 16-bit integer in HL.
The Roman numeral must be in uppercase letters.
<syntaxhighlight lang="8080asm"> org 100h
jmp test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a zero-terminated Roman numeral string in BC
;; and returns 16-bit integer in HL.
;; All registers destroyed.
roman: dcx b
romanfindend: inx b ; load next character
ldax b
inr e
ana a ; are we there yet
jnz romanfindend
lxi h,0 ; zero HL to hold the total
push h ; stack holds the previous roman numeral
romanloop: dcx b ; get next roman numeral
ldax b ; (work backwards)
call romandgt
jc romandone ; carry set = not Roman anymore
xthl ; load previous roman numeral
call cmpdehl ; DE < HL?
mov h,d ; in any case, DE is now the previous
mov l,e ; Roman numeral
xthl ; bring back the total
jnc romanadd
mov a,d ; DE (current) < HL (previous)
cma ; so this Roman digit must be subtracted
mov d,a ; from the total.
mov a,e ; so we negate it before adding it
cma ; two's complement: -de = (~de)+1
mov e,a
inx d
romanadd: dad d ; add to running total
jmp romanloop
romandone: pop d ; remove temporary variable from stack
ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 16-bit compare DE with HL, set flags
;; accordingly. A destroyed.
cmpdehl: mov a,d
cmp h
rnz
mov a,e
cmp l
ret
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a single Roman 'digit' in A,
;; and returns its value in DE (0 if invalid)
;; All other registers preserved.
romandgt: push h ; preserve hl for the caller
lxi h,romantab
mvi e,7 ; e=counter
romandgtl: cmp m ; check table entry
jz romanfound
inx h ; move to next table entry
inx h
inx h
dcr e ; decrease counter
jnz romandgtl
pop h ; we didn't find it
stc ; set carry
ret ; return with DE=0
romanfound: inx h ; we did find it
mov e,m ; load it into DE
inx h
mov d,m
pop h
ana a ; clear carry
ret
romantab: db 'I',1,0 ; 16-bit little endian values
db 'V',5,0
db 'X',10,0
db 'L',50,0
db 'C',100,0
db 'D',0f4h,1
db 'M',0e8h,3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following is testing and I/O code.
test: mvi c,10 ; read string from console
lxi d,bufdef
call 5
mvi c,9 ; print newline
lxi d,nl
call 5
lxi b,buf ; run `roman' on the input string
call roman ; the result is now in hl
lxi d,-10000
call numout ; print 10000s digit
lxi d,-1000
call numout ; print 1000s digit
lxi d,-100
call numout ; print 100s digit
lxi d,-10
call numout ; print 10s digit
lxi d,-1 ; ...print 1s digit
numout: mvi a,-1
push h
numloop: inr a
pop b
push h
dad d
jc numloop
adi '0'
mvi c,2
mov e,a
call 5
pop h
ret
nl: db 13,10,'$'
bufdef: db 16,0
buf: ds 17</syntaxhighlight>
=={{header|Action!}}==
<syntaxhighlight lang="action!">CARD FUNC DecodeRomanDigit(CHAR c)
IF c='I THEN RETURN (1)
ELSEIF c='V THEN RETURN (5)
ELSEIF c='X THEN RETURN (10)
ELSEIF c='L THEN RETURN (50)
ELSEIF c='C THEN RETURN (100)
ELSEIF c='D THEN RETURN (500)
ELSEIF c='M THEN RETURN (1000)
FI
RETURN (0)
CARD FUNC DecodeRomanNumber(CHAR ARRAY s)
CARD res,curr,prev
BYTE i
res=0 prev=0 i=s(0)
WHILE i>0
DO
curr=DecodeRomanDigit(s(i))
IF curr<prev THEN
res==-curr
ELSE
res==+curr
FI
prev=curr
i==-1
OD
RETURN (res)
PROC Test(CHAR ARRAY s)
CARD n
n=DecodeRomanNumber(s)
PrintF("%S=%U%E",s,n)
RETURN
PROC Main()
Test("MCMXC")
Test("MMVIII")
Test("MDCLXVI")
Test("MMMDCCCLXXXVIII")
Test("MMMCMXCIX")
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Roman_numerals_decode.png Screenshot from Atari 8-bit computer]
<pre>
MCMXC=1990
MMVIII=2008
MDCLXVI=1666
MMMDCCCLXXXVIII=3888
MMMCMXCIX=3999
</pre>
=={{header|Ada}}==
<
Pragma Assertion_Policy( Check );
Line 168 ⟶ 445:
Ada.Text_IO.Put_Line("Testing complete.");
End Test_Roman_Numerals;
</syntaxhighlight>
{{out}}
Line 191 ⟶ 468:
{{works with|ALGOL 68G|Any - tested with release 2.2.0}}
Note: roman to int will handle multiple subtraction, e.g. IIIIX for 6.
<
BEGIN
PROC roman digit value = (CHAR roman digit) INT:
Line 238 ⟶ 515:
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</
=={{header|ALGOL W}}==
<
% decodes a roman numeral into an integer %
% there must be at least one blank after the numeral %
Line 335 ⟶ 612:
testRoman( "MDCLXVI" );
end.</
{{out}}
<pre>
Line 370 ⟶ 647:
===Java===
<
Nigel Galloway March 16th., 2012
Line 408 ⟶ 685:
FiveHund: 'D';
Thousand: 'M' ;
NEWLINE: '\r'? '\n' ;</
Using this test data:
<pre>
Line 461 ⟶ 738:
MMXII = 2012
</pre>
=={{header|APL}}==
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">fromRoman←{
rmn←(⎕A,⎕A,'*')[(⎕A,⎕UCS 96+⍳26)⍳⍵] ⍝ make input uppercase
dgt←↑'IVXLCDM' (1 5 10 50 100 500 1000) ⍝ values of roman digits
~rmn∧.∊⊂dgt[1;]:⎕SIGNAL 11 ⍝ domain error if non-roman input
map←dgt[2;dgt[1;]⍳rmn] ⍝ map digits to values
+/map×1-2×(2</map),0 ⍝ subtractive principle
}</syntaxhighlight>
{{out}}
<pre> fromRoman¨ 'MCMXC' 'MMVIII' 'MDCLXVI' 'MMXXI'
1990 2008 1666 2021</pre>
=={{header|AppleScript}}==
====isPrefixOf====
{{trans|JavaScript}}
(Functional ES5 version)
{{trans|Haskell}}
<syntaxhighlight lang="applescript">
------------- INTEGER VALUE OF A ROMAN STRING ------------
-- romanValue :: String -> Int
on romanValue(s)
script roman
Line 476 ⟶ 772:
-- toArabic :: [Char] -> Int
on toArabic(xs)
-- transcribe :: (String, Number) -> Maybe (Number, [String])
script transcribe
-- Value of this matching glyph, with any remaining glyphs
{
else
{}
Line 491 ⟶ 786:
end script
if 0 < length of xs
set
(item 1 of
else
0
Line 503 ⟶ 798:
end romanValue
on run
map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"})
Line 511 ⟶ 806:
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set
end repeat
end tell
if {text, string} contains class of xs then
acc as text
else
acc
end if
end concatMap
-- drop :: Int -> String -> String
on drop(n, xs)
set c to
if script is not c then
if string is not c then
if n < length of xs then
items (1 + n) thru -1 of xs
else
{}
end if
else
text (1 + n) thru -1 of xs
else
""
end if
end if
else
return xs
end if
end drop
-- isPrefixOf :: [a] -> [a] -> Bool
-- isPrefixOf :: String -> String -> Bool
on isPrefixOf(xs, ys)
-- isPrefixOf takes two lists or strings and returns
-- true if and only if the first is a prefix of the second.
script go
on |λ|(xs, ys)
set intX to length of xs
if intX < 1 then
true
else if intX > length of ys then
false
else if class of xs is string then
(offset of xs in ys) = 1
else
set {xxt, yyt} to {uncons(xs), uncons(ys)}
((item 1 of xxt) = (item 1 of yyt)) and ¬
|λ|(item 2 of xxt, item 2 of yyt)
end if
end |λ|
end script
go's |λ|(xs, ys)
end isPrefixOf
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs
if list is c or string is c then
length of xs
else
end if
end
-- map :: (a -> b) -> [a] -> [b]
Line 564 ⟶ 897:
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
Line 576 ⟶ 910:
end if
end mReturn
-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
if 0 = lng then
missing value
else
if (2 ^ 29 - 1) as integer > lng then
if class of xs is string then
set cs to text items of xs
{item 1 of cs, rest of cs}
else
{item 1 of xs, rest of xs}
end if
else
set nxt to take(1, xs)
if {} is nxt then
missing value
else
{item 1 of nxt, xs}
end if
end if
end if
end uncons</syntaxhighlight>
{{Out}}
<syntaxhighlight lang="applescript">{1990, 1666, 2008}</syntaxhighlight>
====Fold right – subtracting or adding====
{{Works with|Yosemite onwards}}
{{trans|Haskell}}
<syntaxhighlight lang="applescript">use framework "Foundation"
----------- INTEGER VALUE OF ROMAN NUMBER STRING ---------
-- fromRoman :: String -> Int
on fromRoman(s)
script subtractIfLower
on |λ|(l, rn)
set {r, n} to rn
if l ≥ r then -- Digit values that increase (L to R),
{l, n + l} -- (added)
else
{l, n - l} -- Digit values that go down: subtracted.
end if
end |λ|
end script
item 2 of foldr(subtractIfLower, {0, 0}, ¬
map(my charVal, characters of s))
end fromRoman
-- charVal :: Char -> Int
on charVal(C)
set v to lookup(toUpper(C), ¬
{I:1, |V|:5, X:10, |L|:50, C:100, D:500, M:1000})
if missing value is v then
0
else
v
end if
end charVal
--------------------------- TEST -------------------------
on run
map(fromRoman, ¬
{"MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXXI"})
--> {1666, 1990, 2008, 2016, 2021}
end run
-------------------- GENERIC FUNCTIONS -------------------
-- foldr :: (a -> b -> b) -> b -> [a] -> b
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 |λ|(item I of xs, v)
end repeat
return v
end tell
end foldr
-- lookup :: a -> Dict -> Maybe b
on lookup(k, dct)
-- Just the value of k in the dictionary,
-- or missing value if k is not found.
set ca to current application
set v to (ca's NSDictionary's dictionaryWithDictionary:dct)'s ¬
objectForKey:k
if missing value ≠ v then
item 1 of ((ca's NSArray's arrayWithObject:v) as list)
else
missing value
end if
end
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
-- The list obtained by applying f
-- to each element of 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
-- toUpper :: String -> String
on toUpper(str)
tell current application
((its (NSString's stringWithString:(str)))'s ¬
uppercaseStringWithLocale:¬
(its NSLocale's currentLocale())) as text
end tell
end toUpper</syntaxhighlight>
{{Out}}
<syntaxhighlight lang="applescript">{1666, 1990, 2008, 2016, 2021}</syntaxhighlight>
=={{header|BASIC}}==
==={{header|Applesoft BASIC}}===
{{trans|BBC BASIC}}
<syntaxhighlight lang="gwbasic"> 10 LET R$ = "MCMXCIX"
20 GOSUB 100 PRINT "ROMAN NUMERALS DECODED"
30 LET R$ = "MMXII"
40 GOSUB 100
50 LET R$ = "MDCLXVI"
60 GOSUB 100
70 LET R$ = "MMMDCCCLXXXVIII"
80 GOSUB 100
90 END
100 PRINT M$R$,
110 LET M$ = CHR$ (13)
120 GOSUB 150"ROMAN NUMERALS DECODE given R$"
130 PRINT N;
140 RETURN
150 IF NOT C THEN GOSUB 250INITIALIZE
160 LET J = 0
170 LET N = 0
180 FOR I = LEN (R$) TO 1 STEP - 1
190 LET P = J
200 FOR J = 1 TO C
210 IF MID$ (C$,J,1) < > MID$ (R$,I,1) THEN NEXT J
220 IF J < = C THEN N = N + R(J) * ((J > = P) * 2 - 1)
230 NEXT I
240 RETURN
250 READ C$
260 LET C = LEN (C$)
270 DIM R(C)
280 FOR I = 0 TO C
290 READ R(I)
300 NEXT I
310 RETURN
320 DATA "IVXLCDM",0,1,5,10,50,100,500,1000</syntaxhighlight>
==={{header|BASIC256}}===
<syntaxhighlight lang="freebasic">function romToDec (roman$)
num = 0
prenum = 0
for i = length(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 -= n else num += n
preNum = n
next i
return num
end function
#Testing
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</syntaxhighlight>
==={{header|BBC BASIC}}===
<syntaxhighlight lang="bbcbasic"> 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%</syntaxhighlight>
{{out}}
<pre>MCMXCIX 1999
MMXII 2012
MDCLXVI 1666
MMMDCCCLXXXVIII 3888</pre>
==={{header|Chipmunk Basic}}===
====Through IF-THEN statements====
{{works with|Chipmunk Basic|3.6.4}}
{{works with|Applesoft BASIC}}
{{works with|MSX_BASIC}}
{{works with|QBasic}}
<syntaxhighlight lang="qbasic">100 cls : rem 100 home for Applesoft BASIC
110 roman$ = "MCMXCIX" : print roman$,"=> "; : gosub 170 : print decimal '1999
120 roman$ = "XXV" : print roman$,"=> "; : gosub 170 : print decimal '25
130 roman$ = "CMLIV" : print roman$,"=> "; : gosub 170 : print decimal '954
140 roman$ = "MMXI" : print roman$,"=> "; : gosub 170 : print decimal '2011
150 end
160 rem Decode from roman
170 decimal = 0
180 predecimal = 0
190 for i = len(roman$) to 1 step -1
200 x$ = mid$(roman$,i,1)
210 if x$ = "M" then n = 1000 : goto 280
220 if x$ = "D" then n = 500 : goto 280
230 if x$ = "C" then n = 100 : goto 280
240 if x$ = "L" then n = 50 : goto 280
250 if x$ = "X" then n = 10 : goto 280
260 if x$ = "V" then n = 5 : goto 280
270 if x$ = "I" then n = 1
280 if n < predecimal then decimal = decimal-n
285 if n >= predecimal then decimal = decimal+n
290 predecimal = n
300 next i
310 return</syntaxhighlight>
====Through SELECT CASE statement====
{{works with|Chipmunk Basic|3.6.4}}
<syntaxhighlight lang="qbasic">100 cls
110 roman$ = "MCMXCIX" : print roman$,"=> "; : gosub 170 : print decimal '1999
120 roman$ = "XXV" : print roman$,"=> "; : gosub 170 : print decimal '25
130 roman$ = "CMLIV" : print roman$,"=> "; : gosub 170 : print decimal '954
140 roman$ = "MMXI" : print roman$,"=> "; : gosub 170 : print decimal '2011
150 end
160 rem Decode from roman
170 decimal = 0
180 predecimal = 0
190 for i = len(roman$) to 1 step -1
200 x$ = mid$(roman$,i,1)
210 select case x$
220 case "M" : n = 1000
230 case "D" : n = 500
240 case "C" : n = 100
250 case "L" : n = 50
260 case "X" : n = 10
270 case "V" : n = 5
280 case "I" : n = 1
290 case else : print "not a roman numeral" : end
300 end select
310 if n < predecimal then decimal = decimal-n else decimal = decimal+n
320 predecimal = n
330 next i
340 return</syntaxhighlight>
==={{header|FreeBASIC}}===
<syntaxhighlight lang="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</syntaxhighlight>
{{out}}
<pre>MCMXC => 1990
MMVIII => 2008
MDCLXVI => 1666</pre>
==={{header|FutureBasic}}===
<syntaxhighlight lang="futurebasic">window 1
local fn RomantoDecimal( roman as CFStringRef ) as long
long i, n, preNum = 0, num = 0
for i = len(roman) - 1 to 0 step -1
n = 0
select ( fn StringCharacterAtIndex( roman, i ) )
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
end select
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" )
HandleEvents</syntaxhighlight>
{{out}}
<pre> MCMXC = 1990
MMVIII = 2008
MMXVI = 2016
MDCLXVI = 1666
MCMXIV = 1914
DXIII = 513
M = 1000
DXIII = 513
XXXIII = 33</pre>
==={{header|Gambas}}===
<syntaxhighlight lang="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</syntaxhighlight>
'''[http://www.cogier.com/gambas/Roman%20Numeral%20converter.png Click here for image of running code]'''
==={{header|GW-BASIC}}===
The [[#Chipmunk_Basic|Chipmunk Basic]] [[#Through_IF-THEN_statements|through IF-THEN statements]] solution works without any changes.
==={{header|Liberty BASIC}}===
As Fortran & PureBasic.
<syntaxhighlight lang="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 <lastval then
arabic =arabic -n
else
arabic =arabic +n
end if
lastval =n
next
romanDec =arabic
end function</syntaxhighlight>
{{out}}
<pre>MCMXCIX = 1999
MDCLXVI = 1666
XXV = 25
CMLIV = 954
MMXI = 2011</pre>
==={{header|MSX Basic}}===
The [[#Chipmunk_Basic|Chipmunk Basic]] [[#Through_IF-THEN_statements|through IF-THEN statements]] solution works without any changes.
==={{header|PureBasic}}===
<syntaxhighlight lang="purebasic">Procedure romanDec(roman.s)
Protected i, n, lastval, arabic
For i = Len(roman) To 1 Step -1
Select UCase(Mid(roman, i, 1))
Case "M"
n = 1000
Case "D"
n = 500
Case "C"
n = 100
Case "L"
n = 50
Case "X"
n = 10
Case "V"
n = 5
Case "I"
n = 1
Default
n = 0
EndSelect
If (n < lastval)
arabic - n
Else
arabic + n
EndIf
lastval = n
Next
ProcedureReturn arabic
EndProcedure
If OpenConsole()
PrintN(Str(romanDec("MCMXCIX"))) ;1999
PrintN(Str(romanDec("MDCLXVI"))) ;1666
PrintN(Str(romanDec("XXV"))) ;25
PrintN(Str(romanDec("CMLIV"))) ;954
PrintN(Str(romanDec("MMXI"))) ;2011
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</syntaxhighlight>
{{out}}
<pre>1999
1666
25
954
2011</pre>
==={{header|QBasic}}===
<syntaxhighlight lang="qbasic">FUNCTION romToDec (roman$)
num = 0
prenum = 0
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 i
romToDec = num
END FUNCTION
!Testing
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</syntaxhighlight>
==={{header|QB64}}===
<syntaxhighlight lang="qb64">SCREEN _NEWIMAGE(400, 600, 32)
CLS
Main:
'------------------------------------------------
' CALLS THE romToDec FUNCTION WITH THE ROMAN
' NUMERALS AND RETURNS ITS DECIMAL EQUIVELENT.
'
PRINT "ROMAN NUMERAL TO DECIMAL CONVERSION"
PRINT: PRINT
PRINT "MDCCIV = "; romToDec("MDCCIV") '1704
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 "MMIIIX = "; romToDec("MMIIIX") '2011
PRINT: PRINT
PRINT "2011 can be written either as MMXI or MMIIIX"
PRINT "With the IX = 9, MMIIIX is also 2011."
PRINT "2011 IS CORRECT (MM=2000 + II = 2 + IX = 9)"
END
FUNCTION romToDec (roman AS STRING)
'------------------------------------------------------
' 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</syntaxhighlight>
==={{header|Run BASIC}}===
<syntaxhighlight lang="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</syntaxhighlight>
==={{header|TechBASIC}}===
<syntaxhighlight lang="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</syntaxhighlight>
{{out}}
<pre>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</pre>
==={{header|TI-83 BASIC}}===
Using the Rom‣Dec function "real(21," from [http://www.detachedsolutions.com/omnicalc/ Omnicalc].
<syntaxhighlight lang="ti83b">PROGRAM:ROM2DEC
:Input Str1
:Disp real(21,Str1)</syntaxhighlight>
Using TI-83 BASIC
<syntaxhighlight lang="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<P:Then
:Y–N➞Y
:Else
:Y+N➞Y
:End
:N➞P
:End
:Disp Y</syntaxhighlight>
==={{header|True BASIC}}===
<syntaxhighlight lang="qbasic">FUNCTION romtodec(roman$)
LET num = 0
LET prenum = 0
FOR i = len(roman$) to 1 step -1
LET x$ = (roman$)[i:i+1-1]
LET n = 0
IF x$ = "M" then LET n = 1000
IF x$ = "D" then LET n = 500
IF x$ = "C" then LET n = 100
IF x$ = "L" then LET n = 50
IF x$ = "X" then LET n = 10
IF x$ = "V" then LET n = 5
IF x$ = "I" then LET n = 1
IF n < prenum then LET num = num-n else LET num = num+n
LET prenum = n
NEXT i
LET romtodec = num
END FUNCTION
!Testing
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
END</syntaxhighlight>
==={{header|XBasic}}===
{{works with|Windows XBasic}}
<syntaxhighlight lang="qbasic">PROGRAM "romandec"
VERSION "0.0000"
DECLARE FUNCTION Entry ()
DECLARE FUNCTION romToDec (roman$)
FUNCTION Entry ()
PRINT "MCMXCIX = "; romToDec("MCMXCIX")
PRINT "MDCLXVI = "; romToDec("MDCLXVI")
PRINT "XXV = "; romToDec("XXV")
PRINT "CMLIV = "; romToDec("CMLIV")
PRINT "MMXI = "; romToDec("MMXI")
END FUNCTION
FUNCTION romToDec (roman$)
num = 0
prenum = 0
FOR i = LEN(roman$) TO 1 STEP -1
x$ = MID$(roman$, i, 1)
SELECT CASE x$
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
END SELECT
IF n < prenum THEN num = num-n ELSE num = num+n
prenum = n
NEXT i
RETURN num
END FUNCTION
END PROGRAM</syntaxhighlight>
==={{header|Yabasic}}===
<syntaxhighlight lang="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</syntaxhighlight>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">syms: #[ M: 1000, D: 500, C: 100, L: 50, X: 10, V: 5, I: 1 ]
fromRoman: function [roman][
ret: 0
loop 0..(size roman)-2 'ch [
fst: roman\[ch]
snd: roman\[ch+1]
valueA: syms\[fst]
valueB: syms\[snd]
if? valueA < valueB -> ret: ret - valueA
else -> ret: ret + valueA
]
return ret + syms\[last roman]
]
loop ["MCMXC" "MMVIII" "MDCLXVI"] 'r -> print [r "->" fromRoman r]</syntaxhighlight>
{{out}}
<pre>MCMXC -> 1990
MMVIII -> 2008
MDCLXVI -> 1666</pre>
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
<
res := 0
Loop Parse, str
Line 605 ⟶ 1,846:
Loop Parse, test, |
res .= A_LoopField "`t= " Roman_Decode(A_LoopField) "`r`n"
clipboard := res</
{{out}}
<pre>MCMXC = 1990
Line 612 ⟶ 1,853:
=={{header|AWK}}==
<
BEGIN {
leng = split("MCMXC MMVIII MDCLXVI",arr," ")
Line 634 ⟶ 1,875:
}
return( (a>0) ? a : "" )
}</
{{out}}
<pre>MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666</pre>
=={{header|Batch File}}==
{{trans|Fortran}}
<
setlocal enabledelayedexpansion
Line 713 ⟶ 1,927:
set lastval=!n!
)
goto :EOF</
{{Out}}
<pre>MCMXC = 1990
Line 720 ⟶ 1,934:
CDXLIV = 444
XCIX = 99</pre>
=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"
let roman(s) = valof
$( let digit(ch) = valof
$( let ds = table 'm','d','c','l','x','v','i'
let vs = table 1000,500,100,50,10,5,1
for i=0 to 6
if ds!i=(ch|32) then resultis vs!i
resultis 0
$)
let acc = 0
for i=1 to s%0
$( let d = digit(s%i)
if d=0 then resultis 0
test i<s%0 & d<digit(s%(i+1))
do acc := acc-d
or acc := acc+d
$)
resultis acc
$)
let show(s) be writef("%S: %N*N", s, roman(s))
let start() be
$( show("MCMXC")
show("MDCLXVI")
show("MMVII")
show("MMXXI")
$)</syntaxhighlight>
{{out}}
<pre>MCMXC: 1990
MDCLXVI: 1666
MMVII: 2007
MMXXI: 2021</pre>
=={{header|BQN}}==
<syntaxhighlight lang="bqn">⟨ToArabic⇐A⟩ ← {
c ← "IVXLCDM" # Characters
v ← ⥊ (10⋆↕4) ×⌜ 1‿5 # Their values
A ⇐ +´∘(⊢ׯ1⋆<⟜«) v ⊏˜ c ⊐ ⊢
}</syntaxhighlight>
{{out|Example use}}
<syntaxhighlight lang="bqn"> ToArabic¨ "MCMXC"‿"MDCLXVI"‿"MMVII"‿"MMXXI"
⟨ 1990 1666 2007 2021 ⟩</syntaxhighlight>
=={{header|Bracmat}}==
{{trans|Icon and Unicon}}
<
= nbr,lastVal,val
. 0:?nbr:?lastVal
Line 762 ⟶ 2,024:
: ? (?L.?D) (?&test$!L&~)
| done
);</
{{out}}
<pre>M 1000
Line 777 ⟶ 2,039:
=={{header|C}}==
Note: the code deliberately did not distinguish between "I", "J" or "U", "V", doing what Romans did for fun.
<
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 };
Line 823 ⟶ 2,085:
return 0;
}</
=={{header|C sharp|C#}}==
<
using System.Collections.Generic;
Line 945 ⟶ 2,149:
}
}
}</
{{out}}
<pre>MCMXC: 1990
Line 951 ⟶ 2,155:
MDCLXVI: 1666
</pre>
=={{header|C++}}==
<syntaxhighlight lang="cpp">
#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;
}
</syntaxhighlight>
{{out}}
<PRE>MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666</PRE>
=={{header|Ceylon}}==
<
value numerals = map {
Line 989 ⟶ 2,251:
assert(toHindu("MCMXC") == 1990);
assert(toHindu("MMVIII") == 2008);
}</
=={{header|Clojure}}==
<
;; Incorporated some improvements from the alternative implementation below
(defn ro2ar [r]
Line 1,007 ⟶ 2,269:
(map numerals)
(reduce (fn [[sum lastv] curr] [(+ sum curr (if (< lastv curr) (* -2 lastv) 0)) curr]) [0,0])
first))</
{{out}}
<pre>(map ro2ar ["MDCLXVI" "MMMCMXCIX" "XLVIII" "MMVIII"])
(1666 3999 48 2008)</pre>
=={{header|CLU}}==
<syntaxhighlight lang="clu">roman = cluster is decode
rep = null
digit_value = proc (c: char) returns (int) signals (invalid)
if c < 'a' then c := char$i2c(char$c2i(c) + 32) end
if c = 'm' then return(1000)
elseif c = 'd' then return(500)
elseif c = 'c' then return(100)
elseif c = 'l' then return(50)
elseif c = 'x' then return(10)
elseif c = 'v' then return(5)
elseif c = 'i' then return(1)
else signal invalid
end
end digit_value
decode = proc (s: string) returns (int) signals (invalid)
acc: int := 0
for i: int in int$from_to(1, string$size(s)) do
d: int := digit_value(s[i])
if i < string$size(s) cand d < digit_value(s[i+1]) then
acc := acc - d
else
acc := acc + d
end
end resignal invalid
return(acc)
end decode
end roman
start_up = proc ()
po: stream := stream$primary_output()
tests: array[string] := array[string]$
["MCMXC", "mdclxvi", "MmViI", "mmXXi", "INVALID"]
for test: string in array[string]$elements(tests) do
stream$puts(po, test || ": ")
stream$putl(po, int$unparse(roman$decode(test))) except when invalid:
stream$putl(po, "not a valid Roman numeral!")
end
end
end start_up</syntaxhighlight>
{{out}}
<pre>MCMXC: 1990
mdclxvi: 1666
MmViI: 2007
mmXXi: 2021
INVALID: not a valid Roman numeral!</pre>
=={{header|COBOL}}==
<syntaxhighlight lang="cobol">
IDENTIFICATION DIVISION.
PROGRAM-ID. UNROMAN.
Line 1,090 ⟶ 2,402:
.
END PROGRAM UNROMAN.
</syntaxhighlight>
{{out}} input was supplied via STDIN
<pre>
Line 1,131 ⟶ 2,443:
=={{header|CoffeeScript}}==
<
# s is well-formed Roman Numeral >= I
numbers =
Line 1,166 ⟶ 2,478:
dec = roman_to_demical(roman)
console.log "error" if dec != expected
console.log "#{roman} = #{dec}"</
=={{header|Common Lisp}}==
<
(defun mapcn (chars nums string)
(loop as char across string as i = (position char chars) collect (and i (nth i nums))))
Line 1,176 ⟶ 2,488:
(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)))
</syntaxhighlight>
Description:
Line 1,191 ⟶ 2,503:
Test code:
<
(format t "~a:~10t~d~%" r (parse-roman r)))</
{{out}}
<pre>MCMXC: 1990
MDCLXVI: 1666
MMVIII: 2008</pre>
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
include "argv.coh";
# Decode the Roman numeral in the given string.
# Returns 0 if the string does not contain a valid Roman numeral.
sub romanToDecimal(str: [uint8]): (rslt: uint16) is
# Look up a Roman digit
sub digit(char: uint8): (val: uint16) is
# Definition of Roman numerals
record RomanDigit is
char: uint8;
value: uint16;
end record;
var digits: RomanDigit[] := {
{'I',1}, {'V',5}, {'X',10}, {'L',50},
{'C',100}, {'D',500}, {'M',1000}
};
char := char & ~32; # make uppercase
# Look up given digit
var i: @indexof digits := 0;
while i < @sizeof digits loop
val := digits[i].value;
if digits[i].char == char then
return;
end if;
i := i + 1;
end loop;
val := 0;
end sub;
rslt := 0;
while [str] != 0 loop
var cur := digit([str]); # get value of current digit
if cur == 0 then rslt := 0; return; end if; # stop when invalid
str := @next str;
if digit([str]) > cur then
# a digit followed by a larger digit should be subtracted from
# the total
rslt := rslt - cur;
else
rslt := rslt + cur;
end if;
end loop;
end sub;
# Read a Roman numeral from the command line and print its output
ArgvInit();
var argmt := ArgvNext();
if argmt == (0 as [uint8]) then
# No argument
print("No argument\n");
ExitWithError();
end if;
print_i16(romanToDecimal(argmt));
print_nl();</syntaxhighlight>
{{out}}
<pre>$ ./romandec.386 MCMXC
1990
$ ./romandec.386 MDCLXVI
1666
$ ./romandec.386 MMVII
2007</pre>
=={{header|D}}==
<
int toArabic(in string s) /*pure nothrow*/ {
Line 1,217 ⟶ 2,599:
assert("MMVIII".toArabic == 2008);
assert("MDCLXVI".toArabic == 1666);
}</
Alternative more functional version:
<
immutable uint[string] w2s;
Line 1,240 ⟶ 2,622:
assert("MMVIII".toArabic == 2008);
assert("MDCLXVI".toArabic == 1666);
}</
=={{header|Delphi}}/{{header|Pascal}}==
<
{$APPTYPE CONSOLE}
Line 1,286 ⟶ 2,668:
Writeln(RomanToInteger('MMVIII')); // 2008
Writeln(RomanToInteger('MDCLXVI')); // 1666
end.</
=={{header|EasyLang}}==
<syntaxhighlight lang="text">
func rom2dec rom$ .
symbols$[] = [ "M" "D" "C" "L" "X" "V" "I" ]
values[] = [ 1000 500 100 50 10 5 1 ]
val = 0
for dig$ in strchars rom$
for i = 1 to len symbols$[]
if symbols$[i] = dig$
v = values[i]
.
.
val += v
if oldv < v
val -= 2 * oldv
.
oldv = v
.
return val
.
print rom2dec "MCMXC"
print rom2dec "MMVIII"
print rom2dec "MDCLXVI"
</syntaxhighlight>
=={{header|ECL}}==
The best declarative approach:
<syntaxhighlight lang="ecl">
MapChar(STRING1 c) := CASE(c,'M'=>1000,'D'=>500,'C'=>100,'L'=>50,'X'=>10,'V'=>5,'I'=>1,0);
Line 1,308 ⟶ 2,715:
RomanDecode('MMVIII'); //2008
RomanDecode('MDCLXVI'); //1666
RomanDecode('MDLXVI'); //1566</
Here's an alternative that emulates the wat procedural code would approach the problem:
<
RomanDecode(STRING s) := FUNCTION
SetWeights := [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
Line 1,350 ⟶ 2,757:
RomanDecode('MMVIII'); //2008
RomanDecode('MDCLXVI'); //1666
RomanDecode('MDLXVI'); //1566</
=={{header|Eiffel}}==
Line 1,357 ⟶ 2,763:
This solution is case insensitive. It performs no input validation other than checking that all Roman digits in the input string are one of <tt>M</tt>, <tt>D</tt>, <tt>C</tt>, <tt>L</tt>, <tt>X</tt>, <tt>V</tt>, and <tt>I</tt>.
<
APPLICATION
Line 1,467 ⟶ 2,873:
end
end</
=={{header|Elena}}==
ELENA 6.x :
<syntaxhighlight lang="elena">import extensions;
import system'collections;
import system'routines;
import system'culture;
static RomanDictionary = Dictionary.new()
.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.toUpper();
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())
}</syntaxhighlight>
{{out}}
<pre>
MCMXC: 1990
MMVIII: 2008
MDCLXVI:1666
</pre>
=={{header|Elixir}}==
{{trans|Erlang}}
<
def decode([]), do: 0
def decode([x]), do: to_value(x)
Line 1,477 ⟶ 2,938:
case {to_value(h1), to_value(h2)} do
{v1, v2} when v1 < v2 -> v2 - v1 + decode(rest)
{v1, _} -> v1 + decode([h2 | rest])
end
Line 1,491 ⟶ 2,951:
end
Enum.each(['MCMXC', 'MMVIII', 'MDCLXVI', 'IIIID'], fn clist ->
IO.puts "#{clist}\t: #{Roman_numeral.decode(clist)}"
end)</
{{out}}
Line 1,503 ⟶ 2,963:
=={{header|Emacs Lisp}}==
<syntaxhighlight lang="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,
Line 1,519 ⟶ 2,978:
((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</syntaxhighlight>
{{out}}
(ro2ar '(M D C L X V I))
=={{header|Erlang}}==
Putting the character X into a list, [X], creates a string with a single character.
<syntaxhighlight lang="erlang">
-module( roman_numerals ).
Line 1,551 ⟶ 3,008:
{V1, _} -> V1 + decode_from_string([H2|Rest])
end.
</syntaxhighlight>
{{out}}
Line 1,564 ⟶ 3,021:
=={{header|ERRE}}==
<syntaxhighlight lang="erre">
PROGRAM ROMAN2ARAB
Line 1,594 ⟶ 3,051:
TOARAB("MMMDCCCLXXXVIII"->ANS%) PRINT(ANS%)
END PROGRAM
</syntaxhighlight>
If the answer is -9999, roman number is illegal.
=={{header|Euphoria}}==
{{trans|PureBasic}}
<
function romanDec(sequence roman)
integer n, lastval, arabic
Line 1,623 ⟶ 3,080:
? romanDec("XXV")
? romanDec("CMLIV")
? romanDec("MMXI")</
{{out}}
<pre>1999
Line 1,633 ⟶ 3,090:
=={{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.
<
let rec convert arabic lastval = function
| head::tail ->
Line 1,649 ⟶ 3,106:
| _ -> 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.
<
let convert (arabic,lastval) c =
let n = match c with
Line 1,667 ⟶ 3,124:
let (arabic, lastval) = Seq.fold convert (0,0) roman
arabic + lastval
;;</
Test code:
<
for test in tests do Printf.printf "%s: %d\n" test (decimal_of_roman test)
;;</
{{out}}
Line 1,681 ⟶ 3,138:
MCMLXXVII: 1977
MMX: 2010</pre>
=={{header|Factor}}==
A roman numeral library ships with Factor.
<syntaxhighlight lang="factor">USE: roman
( scratchpad ) "MMMCCCXXXIII" roman> .
3333</syntaxhighlight>
Implementation for decoding:
<syntaxhighlight lang="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 ;</syntaxhighlight>
=={{header|FALSE}}==
<syntaxhighlight lang="false">[ 32| {get value of Roman digit on stack}
$'m= $[\% 1000\]? ~[
$'d= $[\% 500\]? ~[
$'c= $[\% 100\]? ~[
$'l= $[\% 50\]? ~[
$'x= $[\% 10\]? ~[
$'v= $[\% 5\]? ~[
$'i= $[\% 1\]? ~[
% 0
]?]?]?]?]?]?]?
]r:
0 {accumulator}
^r;! {read first Roman digit}
[^r;!$][ {read another, and as long as it is valid...}
\$@@\$@@ {copy previous and current}
\>[\_\]? {if previous smaller than current, negate previous}
@@+\ {add previous to accumulator}
]#
%+. {add final digit to accumulator and output}
10, {and a newline}</syntaxhighlight>
{{out}}
<pre>$ ./false -q romandec.f <<<MCMXC
1990
$ ./false -q romandec.f <<<MMVIII
2008
$ ./false -q romandec.f <<<MDCLXVI
1666
$ ./false -q romandec.f <<<MMXXI
2021</pre>
=={{header|Forth}}==
<
1000 128 * char M + ,
500 128 * char D + ,
Line 1,708 ⟶ 3,228:
;
s" MCMLXXXIV" >arabic .</
<
\ 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
:
: 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@ ;
:
: ?NEGATE ( n -- +n | -n) \ conditional NEGATE
CURNDX @ OLDNDX @ <
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 ;
</syntaxhighlight>
Alternative Version Forth Console Test
<pre>\ test code ok
S" mmm" >ARABIC . 3000 ok
S" mcmxlvi" >ARABIC . 1946 ok
S" mdc" >ARABIC . 1600 ok
S" mdcl" >ARABIC . 1650 ok
S" mcmlxxxiv" >ARABIC . 1984 ok
=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
<
implicit none
Line 1,814 ⟶ 3,331:
end do
end function decode
end program Roman_decode</
{{out}}
<pre> 1990 2008 1666</pre>
=={{header|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].
<
import (
Line 2,094 ⟶ 3,420:
}
}
}</
{{out}}
<pre>
Line 2,103 ⟶ 3,429:
Simpler:
<
import (
Line 2,139 ⟶ 3,465:
fmt.Printf("%-10s == %d\n", roman_digit, from_roman(roman_digit))
}
}</
=={{header|Golo}}==
<syntaxhighlight lang="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())
}
</syntaxhighlight>
=={{header|Groovy}}==
Solution:
<
I(1), V(5), X(10), L(50), C(100), D(500), M(1000);
Line 2,162 ⟶ 3,537:
}
}
}</
Test:
<
Digit Values = ${RomanDigits.values()}
M => ${RomanDigits.parse('M')}
Line 2,175 ⟶ 3,550:
MCDXLIV => ${RomanDigits.parse('MCDXLIV')}
MDCLXVI => ${RomanDigits.parse('MDCLXVI')}
"""</
{{out}}
<pre>Digit Values = [I=1, V=5, X=10, L=50, C=100, D=500, M=1000]
Line 2,189 ⟶ 3,564:
=={{header|Haskell}}==
====Simple declarative idiom====
Compiles with GHC.
<syntaxhighlight lang="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))) ++ ")"
</syntaxhighlight>
{{Out}}
<pre>
MCMXC = 1990 (PASS)
MMVIII = 2008 (PASS)
MDCLXVI = 1666 (PASS)
</pre>
====Same logic as above but in a functional idiom====
<syntaxhighlight lang="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))) ++ ")"
</syntaxhighlight>
====List comprehension====
<
mapping = [("M",1000),("CM",900),("D",500),("CD",400),("C",100),("XC",90),
Line 2,198 ⟶ 3,678:
toArabic "" = 0
toArabic str = num + toArabic xs
where (num, xs):_ = [ (num, drop (length n) str) | (n,num) <- mapping, isPrefixOf n str ]</
Usage:
<pre>
Line 2,210 ⟶ 3,690:
====mapAccum====
Or, expressing '''romanValue''' in terms of '''mapAccumL''' (avoiding recursive descent, and visiting each k v pair just once)
<syntaxhighlight lang
import
romanValue :: String -> Int
romanValue =
let tr s (k, v) =
until
(not . isPrefixOf k . fst)
(bimap ((drop . length) k) (v +))
in sum
("IV", 4),
("I", 1)
]
main :: IO ()
main =
mapM_
(print . romanValue)
[ "MDCLXVI",
"MCMXC",
"MMVIII",
"MMXVI",
"MMXVII"
]</syntaxhighlight>
Or, in a '''mapAccumR''' version
<syntaxhighlight lang="haskell">import Data.List (mapAccumR)
import qualified Data.Map.Strict as M
import Data.Maybe (maybe)
fromRoman :: String -> Maybe Int
fromRoman cs =
let
| l > r
| otherwise
in traverse (`M.lookup` mapRoman) cs
>>= ( Just . sum . ((:) <$> fst <*> snd)
. mapAccumR go 0
)
mapRoman :: M.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 =
unlines $
s :
fmap
( ((<>) . rjust w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
rjust n c = drop . length <*> (replicate n c <>)
w = maximum (length . xShow <$> xs)</syntaxhighlight>
{{Out}}
<pre>Decoding Roman numbers:
"MDCLXVI" -> 1666
"MCMXC" -> 1990
"MMVIII" -> 2008
"MMXVI" -> 2016
"MMXVIII" -> 2018
"MMXBIII" -> Unrecognised character</pre>
====Fold====
An alternative solution using a fold. (This turns out to be the fastest of the four approaches here) {{Trans|F#}}
<
fromRoman :: String -> Int
Line 2,293 ⟶ 3,839:
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].
<syntaxhighlight lang="haskell">import qualified Data.Map.Strict as M
import Data.Maybe (maybe)
------------------ ROMAN NUMERALS DECODED ----------------
mapRoman :: M.Map Char Int
mapRoman =
M.fromList $
zip "IVXLCDM" $
scanl (*) 1 (cycle [5,
fromRoman :: String -> Maybe Int
fromRoman cs =
let op l r
| l >= r = (+)
| otherwise = (-)
in snd
. foldr
(\l (r, n) -> (l, op l r n l))
(0, 0)
<$> traverse (`M.lookup` mapRoman) cs
--------------------------- 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 =
unlines $
s :
fmap
( ((<>) . rjust w ' ' . xShow)
<*> ((" -> " <>) . fxShow . f)
)
xs
where
rjust n c = drop . length <*> (replicate n c <>)
w = maximum (length . xShow <$> xs)</syntaxhighlight>
{{Out}}
<pre>Roman numeral decoding as a right fold:
"MDCLXVI" -> 1666
"MCMXC" -> 1990
"MMVIII" -> 2008
"MMXVI" -> 2016
"MMXVII" -> 2017
"QQXVII" -> (Unrecognised character seen)</pre>
====sum . catMaybes====
Line 2,317 ⟶ 3,916:
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)
<syntaxhighlight lang="haskell">import qualified Data.Map.Strict as M (Map, fromList, lookup)
import Data.Maybe (isNothing, isJust, fromJust, catMaybes)
import Data.List (mapAccumL)
Line 2,355 ⟶ 3,956:
main :: IO ()
main = print $ fromRoman <$> ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"]</
{{Out}}
<pre>[1666,1990,2008,2016,2017]</pre>
=={{header|Hoon}}==
Library file (e.g. <code>/lib/rhonda.hoon</code>):
<syntaxhighlight lang="hoon">|%
++ parse
|= t=tape ^- @ud
=. t (cass t)
=| result=@ud
|-
?~ t result
?~ t.t (add result (from-numeral i.t))
=+ [a=(from-numeral i.t) b=(from-numeral i.t.t)]
?: (gte a b) $(result (add result a), t t.t)
$(result (sub (add result b) a), t t.t.t)
++ yield
|= n=@ud ^- tape
=| result=tape
=/ values to-numeral
|-
?~ values result
?: (gte n -.i.values)
$(result (weld result +.i.values), n (sub n -.i.values))
$(values t.values)
++ from-numeral
|= c=@t ^- @ud
?: =(c 'i') 1
?: =(c 'v') 5
?: =(c 'x') 10
?: =(c 'l') 50
?: =(c 'c') 100
?: =(c 'd') 500
?: =(c 'm') 1.000
!!
++ to-numeral
^- (list [@ud tape])
:*
[1.000 "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"]
~
==
--</syntaxhighlight>
Script file ("generator") (e.g. <code>/gen/roman.hoon</code>):
<syntaxhighlight lang="hoon">/+ *roman
:- %say
|= [* [x=$%([%from-roman tape] [%to-roman @ud]) ~] ~]
:- %noun
^- tape
?- -.x
%from-roman "{<(parse +.x)>}"
%to-roman (yield +.x)
==</syntaxhighlight>
=={{header|Icon}} and {{header|Unicon}}==
<
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:
<
local nbr,lastVal,val
Line 2,389 ⟶ 4,056:
}
return nbr
end</
{{out}}
<pre>MCMXC = 1990
MDCLXVI = 1666
MMVIII = 2008</pre>
=={{header|Insitux}}==
{{Trans|Clojure}}
<syntaxhighlight lang="insitux">
(var numerals {"M" 1000 "D" 500 "C" 100 "L" 50 "X" 10 "V" 5 "I" 1})
; Approach A
(function ro->ar r
(-> (reverse (upper-case r))
(map numerals)
(split-with val)
(map (.. +0))
(reduce @(((< % %1) + -)))))
; Approach B
(function ro->ar r
(-> (upper-case r)
(map numerals)
@(reduce (fn [sum lastv] curr [(+ sum curr ((< lastv curr) (* -2 lastv) 0)) curr]) [0 0])
0))
(map ro->ar ["MDCLXVI" "MMMCMXCIX" "XLVIII" "MMVIII"])
</syntaxhighlight>
{{out}}
<pre>
[1666 3999 48 2008]
</pre>
=={{header|J}}==
<
Example use:
<
1990
rom2d 'MDCLXVI'
1666
rom2d 'MMVIII'
2008</
=={{header|Java}}==
{{works with|Java|1.5+}}
<
private static int decodeSingle(char letter) {
switch(letter) {
Line 2,443 ⟶ 4,141:
System.out.println(decode("MDCLXVI")); //1666
}
}</
{{out}}
<pre>1990
Line 2,449 ⟶ 4,147:
1666</pre>
{{works with|Java|1.8+}}
<
import java.util.EnumSet;
import java.util.Collections;
Line 2,507 ⟶ 4,205:
LongStream.of(1999, 25, 944).forEach(RomanNumerals::test);
}
}</
{{out}}
<pre>1999 = MCMXCIX
Line 2,521 ⟶ 4,219:
{{works with|Rhino}}
{{works with|SpiderMonkey}}
<
Values: [['CM', 900], ['CD', 400], ['XC', 90], ['XL', 40], ['IV', 4],
['IX', 9], ['V', 5], ['X', 10], ['L', 50],
Line 2,546 ⟶ 4,244:
var test_datum = test_data[i]
print(test_datum + ": " + Roman.parse(test_datum))
}</
{{out}}
<pre>MCMXC: 1990
Line 2,554 ⟶ 4,252:
====Functional====
{{Trans|Haskell}}
(isPrefixOf example)
<syntaxhighlight lang="javascript">(function (lstTest) {
var mapping = [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ["C", 100], [
Line 2,601 ⟶ 4,300:
return lstTest.map(romanValue);
})(['MCMXC', 'MDCLXVI', 'MMVIII']);</
{{Out}}
<syntaxhighlight lang
or, more natively:
<
function romanValue(s) {
Line 2,636 ⟶ 4,335:
return lstTest.map(romanValue);
})(["MCMXC", "MDCLXVI", "MMVIII", "MMMM"]);</
{{Out}}
<syntaxhighlight lang
===ES6===
====Recursion====
<syntaxhighlight lang="javascript">(() => {
// romanValue :: String -> Int
const romanValue = s =>
Line 2,675 ⟶ 4,375:
// TEST -------------------------------------------------------------------
return ["MCMXC", "MDCLXVI", "MMVIII", "MMMM"].map(romanValue);
})();</
{{Out}}
<syntaxhighlight lang
====Folding from the right====
{{Trans|Haskell}}
(fold and foldr examples)
<syntaxhighlight lang="javascript">(() => {
// -------------- ROMAN NUMERALS DECODED ---------------
// Folding from right to left,
// lower leftward characters are subtracted,
// others are added.
// fromRoman :: String -> Int
const fromRoman = s =>
foldr(l => ([r, n]) => [
l,
l >= r ? (
n + l
) : n - l
])([0, 0])(
[...s].map(charVal)
)[1];
// 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;
};
// ----------------------- TEST ------------------------
const main = () => [
'MDCLXVI', 'MCMXC', 'MMVIII', 'MMXVI', 'MMXVII'
]
.map(fromRoman)
.join('\n');
// ----------------- GENERIC FUNCTIONS -----------------
// foldr :: (a -> b -> b) -> b -> [a] -> b
const foldr = f =>
// Note that that the Haskell signature of foldr
// differs from that of foldl - the positions of
// accumulator and current value are reversed.
a => xs => [...xs].reduceRight(
(a, x) => f(x)(a),
a
);
// MAIN ---
return main();
})();</syntaxhighlight>
{{Out}}
<pre>1666
1990
2008
2016
2017</pre>
====Declarative====
<syntaxhighlight lang="javascript">
(() => {
function toNumeric(value) {
return value
.replace(/IV/, 'I'.repeat(4))
.replace(/V/g, 'I'.repeat(5))
.replace(/IX/, 'I'.repeat(9))
.replace(/XC/, 'I'.repeat(90))
.replace(/XL/, 'I'.repeat(40))
.replace(/X/g, 'I'.repeat(10))
.replace(/L/, 'I'.repeat(50))
.replace(/CD/, 'I'.repeat(400))
.replace(/CM/, 'I'.repeat(900))
.replace(/C/g, 'I'.repeat(100))
.replace(/D/g, 'I'.repeat(500))
.replace(/M/g, 'I'.repeat(1000))
.length;
}
const numerics = ["MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"]
.map(toNumeric);
console.log(numerics);
})();
</syntaxhighlight>
{{Out}}
<pre>
[2016, 1990, 2008, 2000, 1666]
</pre>
=={{header|jq}}==
{{works with|jq|1.4}}
This version requires the Roman numerals to be presented in upper case.
<
def addRoman(n):
if length == 0 then n
Line 2,701 ⟶ 4,500:
error("invalid Roman numeral: " + tostring)
end;
addRoman(0);</
'''Example:'''
<
{{out}}
<
MCMXC => 1990
MMVIII => 2008
MDCLXVI => 1666</
=={{header|Jsish}}==
Duplicate of the Jsish module used in [[Roman_numerals/Encode#Jsish]].
{{out}}
<pre>prompt$ jsish -e 'require("Roman"); puts(Roman.fromRoman("MDCLXVI"));'
1666</pre>
=={{header|Julia}}==
{{works with|Julia|0.6}}
'''The Function''':
<syntaxhighlight lang="julia">function parseroman(
for d in reverse(uppercase(rnum))
val = try
catch
throw(DomainError())
end
if val > mval maxval =
if val
else
end
end
return
end</syntaxhighlight>
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''':
<syntaxhighlight lang="julia">using Printf
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(
end</syntaxhighlight>
{{out}}
<pre> 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</pre>
=={{header|K}}==
{{trans|J}}
<
'''Example:'''
<
1990 2008 1666</
=={{header|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:
<
fun romanDecode(roman: String): Int {
Line 2,809 ⟶ 4,601:
val romans = arrayOf("I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI")
for (roman in romans) println("${roman.padEnd(10)} = ${romanDecode(roman)}")
}</
{{out}}
Line 2,826 ⟶ 4,618:
=={{header|Lasso}}==
<
//decode roman
define decodeRoman(roman::string)::integer => {
Line 2,848 ⟶ 4,640:
'MMVIII as integer is '+decodeRoman('MMVIII')
br
'MDCLXVI as integer is '+decodeRoman('MDCLXVI')</
=={{header|LiveScript}}==
<
# String → Number
Line 2,917 ⟶ 4,656:
fold(_convert, [0, 0]) >> sum
{[rom, decimal_of_roman rom] for rom in <[ MCMXC MMVII MDCLXVII MMMCLIX MCMLXXVII MMX ]>}</
Output:
Line 2,923 ⟶ 4,662:
=={{header|Logo}}==
<
; First, some useful substring utilities
Line 2,957 ⟶ 4,696:
foreach [MCMXC MDCLXVI MMVIII] [print (sentence (word ? "|: |) from_roman ?)]
bye</
{{out}}
<pre>MCMXC: 1990
Line 2,965 ⟶ 4,704:
=={{header|Lua}}==
<
local Num = { ["M"] = 1000, ["D"] = 500, ["C"] = 100, ["L"] = 50, ["X"] = 10, ["V"] = 5, ["I"] = 1 }
local numeral = 0
Line 2,989 ⟶ 4,728:
print( ToNumeral( "MCMXC" ) )
print( ToNumeral( "MMVIII" ) )
print( ToNumeral( "MDCLXVI" ) )</
<pre>1990
2008
1666</pre>
=={{header|M2000 Interpreter}}==
Maximum Roman number is MMMCMXCIX (3999)
<syntaxhighlight lang="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))<i then rom$="A": exit
insert i,2 rom$=rep$ ' replace at pos i with rep$ and place a space to i+1
end if
loop
}
rom$=filter$(rom$," ") ' remove spaces if exist
stack singlerom {
if empty then exit
read cc$, value
count=0
while left$(rom$,1)=cc$
insert 1, 1 rom$=""
count++
acc+=value
end while
if count>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
</syntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll">
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
</pre >
=={{header|Maple}}==
<
seq(printf("%a\n", f(i)), i in [MCMXC, MMVIII, MDCLXVI]);</
{{out}}
<pre>
Line 3,004 ⟶ 4,853:
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<
{{out}}
<pre>2405</pre>
=={{header|MATLAB}}==
<
% ROM2DEC converts Roman numbers to decimal
Line 3,019 ⟶ 4,869:
x = sum(values .* [sign(diff(-values)+eps),1]);
end</
Here is a test:
<
for n = 1 : numel(romanNumbers)
fprintf('%10s = %4d\n',romanNumbers{n}, rom2dec(romanNumbers{n}));
end</
{{out}}
<pre>
Line 3,031 ⟶ 4,881:
MMVIII = 2008
</pre>
=={{header|Mercury}}==
<
:- interface.
Line 3,082 ⟶ 4,931:
Args, !IO).
:- end_module test_roman.</
=={{header|Miranda}}==
<syntaxhighlight lang="miranda">main :: [sys_message]
main = [ Stdout (s ++ ": " ++ show (fromroman s) ++ "\n")
| s <- ["MCMXC", "MDCLXVI", "MMVII", "MMXXIII"]
]
fromroman :: [char]->num
fromroman = f
where f [] = 0
f [x] = r x
f (x:y:xs) = f (y:xs) - r x, if r x < r y
= f (y:xs) + r x, otherwise
r 'M' = 1000
r 'D' = 500
r 'C' = 100
r 'L' = 50
r 'X' = 10
r 'V' = 5
r 'I' = 1</syntaxhighlight>
{{out}}
<pre>MCMXC: 1990
MDCLXVI: 1666
MMVII: 2007
MMXXIII: 2023</pre>
=={{header|Modula-2}}==
<syntaxhighlight lang="modula2">MODULE RomanNumerals;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
FROM Strings IMPORT Length;
(* Convert given Roman numeral to binary *)
PROCEDURE DecodeRoman(s: ARRAY OF CHAR): CARDINAL;
VAR i, d, len, acc: CARDINAL;
PROCEDURE Digit(d: CHAR): CARDINAL;
BEGIN
CASE CHR( BITSET(ORD(d)) + BITSET{5} ) OF (* lowercase *)
'm': RETURN 1000;
| 'd': RETURN 500;
| 'c': RETURN 100;
| 'l': RETURN 50;
| 'x': RETURN 10;
| 'v': RETURN 5;
| 'i': RETURN 1;
ELSE
RETURN 0;
END;
END Digit;
BEGIN
len := Length(s);
acc := 0;
FOR i := 0 TO len-1 DO
d := Digit(s[i]);
IF d=0 THEN RETURN 0; END;
IF (i # len-1) AND (d < Digit(s[i+1])) THEN
acc := acc - d;
ELSE
acc := acc + d;
END;
END;
RETURN acc;
END DecodeRoman;
PROCEDURE Show(s: ARRAY OF CHAR);
BEGIN
WriteString(s);
WriteString(": ");
WriteCard(DecodeRoman(s), 0);
WriteLn();
END Show;
BEGIN
Show("MCMXC");
Show("MDCLXVI");
Show("mmvii");
Show("mmxxi");
END RomanNumerals.</syntaxhighlight>
{{out}}
<pre>MCMXC: 1990
MDCLXVI: 1666
mmvii: 2007
mmxxi: 2021</pre>
=={{header|Nanoquery}}==
{{trans|Java}}
<syntaxhighlight lang="nanoquery">def decodeSingle(letter)
if letter = "M"
return 1000
else if letter = "D"
return 500
else if letter = "C"
return 100
else if letter = "L"
return 50
else if letter = "X"
return 10
else if letter = "V"
return 5
else if letter = "I"
return 1
else
return 0
end
end
def decode(roman)
result = 0
uRoman = roman.toUpperCase()
for (i = 0) (i < len(uRoman) - 1) (i += 1)
if decodeSingle(uRoman[i]) < decodeSingle(uRoman[i + 1])
result -= decodeSingle(uRoman[i])
else
result += decodeSingle(uRoman[i])
end
end
result += decodeSingle(uRoman[len(uRoman) - 1])
return result
end
println decode("MCMXC")
println decode("MMVIII")
println decode("MDCLXVI")</syntaxhighlight>
{{out}}
<pre>1990
2008
1666</pre>
=={{header|NetRexx}}==
<
options replace format comments java crossref savelog symbols binary
Line 3,133 ⟶ 5,112:
end
return digit</
{{out}}
<pre>
Line 3,143 ⟶ 5,122:
=={{header|Nim}}==
{{trans|Python}}
<
let rdecode = {'M': 1000, 'D': 500, 'C': 100, 'L': 50, 'X': 10, 'V': 5, 'I': 1}.toTable
proc decode(roman: string): int =
for i in 0 ..
let (rd, rd1) = (rdecode[roman[i]], rdecode[roman[i+1]])
result += (if rd < rd1: -rd else: rd)
Line 3,154 ⟶ 5,133:
for r in ["MCMXC", "MMVIII", "MDCLXVI"]:
echo r, " ", decode(r)</
{{out}}
<pre>MCMXC 1990
MMVIII 2008
MDCLXVI 1666</pre>
=={{header|OCaml}}==
<
let arabic = ref 0 in
let lastval = ref 0 in
Line 3,183 ⟶ 5,167:
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+}}
<
(* Scan the roman number from right to left. *)
(* When processing a roman digit, if the previously processed roman digit was
Line 3,245 ⟶ 5,229:
print_endline (testit "2 * PI ^ 2" 1); (* The I in PI... *)
print_endline (testit "E = MC^2" 1100)
</syntaxhighlight>
Output:
<pre>
Line 3,267 ⟶ 5,251:
=={{header|PARI/GP}}==
<
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;
Line 3,283 ⟶ 5,267:
);
t+cur
};</
=={{header|Perl}}==
<
{
Line 3,310 ⟶ 5,294:
}
say "$_: ", from_roman($_) for qw(MCMXC MDCLXVI MMVIII);</
{{out}}
<pre>MCMXC: 1990
MDCLXVI: 1666
MMVIII: 2008</pre>
=== Alternate ===
<syntaxhighlight lang="perl">#!/usr/bin/perl
use strict;
use warnings;
sub roman2decimal
(local $_, my $sum, my $zeros) = (shift, 0, '');
$zeros .= 0 while
$sum -= s/I(?=[VX])// -
tr/MDCLX/CLXVI/;
return $sum;
}
print s/$/ ": " . roman2decimal($_) /er while <DATA>;
__DATA__
MCMXC
MMVIII
MDCLXVI</syntaxhighlight>
{{out}}
<pre>
MCMXC: 1990
MMVIII
MDCLXVI: 1666
</pre>
=== Another Alternate ===
<syntaxhighlight lang="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>;
__DATA__
MCMXC
MMVIII
MDCLXVI</syntaxhighlight>
{{out}}
<pre>
MCMXC: 1990
MDCLXVI: 1666
=={{header|Phix}}==
<!--(phixonline)-->
<syntaxhighlight lang="phix">
with javascript_semantics
function romanDec(string s)
for i=length(s) to 1 by -1 do
prev = rn
end for
return {s,res} -- (for output)
end function
?apply({"MCMXC","MMVIII","MDCLXVI"},romanDec)
</syntaxhighlight>
{{out}}
<pre>
{{"MCMXC",1990},{"MMVIII",2008},{"MDCLXVI",1666}}
</pre>
=== cheating slightly ===
<syntaxhighlight lang="phix">
with javascript_semantics
requires("1.0.5")
function romanDec(string s)
return {s,scanf(s,"%R")[1][1]}
end function
</syntaxhighlight>
same output, if applied the same way as above, error handling omitted
=={{header|Phixmonti}}==
<syntaxhighlight lang="phixmonti">def romanDec /# s -- n #/
0 >ps 0 >ps
( ( "M" 1000 ) ( "D" 500 ) ( "C" 100 ) ( "L" 50 ) ( "X" 10 ) ( "V" 5 ) ( "I" 1 ) )
swap upper reverse
len while
pop rot rot tochar getd
if
dup ps> < if 0 swap - endif
dup ps> + >ps
>ps
swap
else
"Error: " print ? ""
endif
len
endwhile
drop drop
ps> drop ps>
enddef
/# usage example: "MMXX" romanDec ? (show 2020) #/</syntaxhighlight>
More traditional solution:
<syntaxhighlight lang="phixmonti">"MDCLXVI" var romans
( 1000 500 100 50 10 5 1 ) var decmls
def romanDec /# s -- n #/
0 var prev
0 var res
upper
( len 1 -1 ) for
get
romans swap find nip
dup if
decmls swap get nip
dup prev < if 0 swap - endif
dup res + var res
var prev
else
"Error" ? 0 var res exitfor
endif
endfor
drop
res
enddef</syntaxhighlight>
=={{header|PHP}}==
<
/**
* @author Elad Yosifon
Line 3,483 ⟶ 5,527:
{
echo "($key == {$value[0]}) => " . ($value[0] === $value[1] ? "true" : "false, should be {$value[1]}.") . "\n";
}</
{{out}}
<pre>
Line 3,507 ⟶ 5,551:
(MCMLXXVII == 1977) => true
</pre>
=={{header|Picat}}==
<syntaxhighlight lang="picat">go =>
List = ["IV",
"XLII",
"M",
"MCXI",
"CMXI",
"MCM",
"MCMXC",
"MMVIII",
"MMIX",
"MCDXLIV",
"MDCLXVI",
"MMXII"],
foreach(R in List)
printf("%-8s: %w\n", R, roman_decode(R))
end,
nl.
roman_decode(Str) = Res =>
if Str == "" then
Res := ""
else
D = new_map(findall((R=D), roman(R,D))),
Res = 0,
Old = 0,
foreach(S in Str)
N = D.get(S),
% Fix for the Roman convention that XC = 90, not 110.
if Old > 0, N > Old then
Res := Res - 2*Old
end,
Res := Res + N,
Old := N
end
end.
roman('I', 1).
roman('V', 5).
roman('X', 10).
roman('L', 50).
roman('C', 100).
roman('D', 500).
roman('M', 1000).</syntaxhighlight>
{{out}}
<pre>IV : 4
XLII : 42
M : 1000
MCXI : 1111
CMXI : 911
MCM : 1900
MCMXC : 1990
MMVIII : 2008
MMIX : 2009
MCDXLIV : 1444
MDCLXVI : 1666
MMXII : 2012</pre>
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp">(de roman2decimal (Rom)
(let L (replace (chop Rom) 'M 1000 'D 500 'C 100 'L 50 'X 10 'V 5 'I 1)
(sum '((A B) (if (>= A B) A (- A))) L (cdr L)) ) )</syntaxhighlight>
Test:
<pre>: (roman2decimal "MCMXC")
-> 1990
: (roman2decimal "MMVIII")
-> 2008
: (roman2decimal "MDCLXVI")
-> 1666</pre>
=={{header|PL/I}}==
<syntaxhighlight lang="pl/i">
test_decode: procedure options (main); /* 28 January 2013 */
declare roman character (20) varying;
Line 3,556 ⟶ 5,675:
end test_decode;
</syntaxhighlight>
<pre>
i 1
Line 3,578 ⟶ 5,697:
MMXIII 2013
</pre>
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
/* CP/M CALLS */
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
/* CP/M COMMAND LINE ARGUMENT */
DECLARE ARG$LPTR ADDRESS INITIAL (80H), ARG$LEN BASED ARG$LPTR BYTE;
DECLARE ARG$PTR ADDRESS INITIAL (81H), ARG BASED ARG$PTR BYTE;
/* CONVERT ROMAN NUMERAL TO BINARY */
READ$ROMAN: PROCEDURE (RP) ADDRESS;
DECLARE DIGITS (7) BYTE INITIAL ('MDCLXVI');
DECLARE VALUES (7) ADDRESS INITIAL (1000,500,100,50,10,5,1);
DECLARE (RP, V, DVAL) ADDRESS, R BASED RP BYTE;
V = 0;
GET$DIGIT: PROCEDURE (D) ADDRESS;
DECLARE (D, I) BYTE;
DO I = 0 TO LAST(DIGITS);
IF DIGITS(I) = D THEN RETURN VALUES(I);
END;
RETURN 0; /* NOT FOUND */
END GET$DIGIT;
DO WHILE R <> '$';
DVAL = GET$DIGIT(R);
IF DVAL = 0 THEN RETURN 0; /* ERROR */
RP = RP + 1;
IF GET$DIGIT(R) > DVAL THEN
V = V - DVAL; /* SUBTRACTIVE PRINCIPLE */
ELSE
V = V + DVAL;
END;
RETURN V;
END READ$ROMAN;
/* PRINT BINARY NUMBER AS DECIMAL */
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (6) BYTE INITIAL ('.....$');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
IF ARG$LEN = 0 THEN DO;
CALL PRINT(.'NO INPUT$');
CALL EXIT;
END;
ARG(ARG$LEN) = '$'; /* TERMINATE ARGUMENT STRING */
CALL PRINT(.ARG(1)); /* PRINT ROMAN NUMERAL */
CALL PRINT(.': $');
CALL PRINT$NUMBER(READ$ROMAN(.ARG(1))); /* CONVERT AND PRINT VALUE */
CALL EXIT;
EOF</syntaxhighlight>
{{out}}
<pre>A>ROMAN MCMXC
MCMXC: 1990
A>ROMAN MDCLXVI
MDCLXVI: 1666
A>ROMAN MMVII
MMVII: 2007
A>ROMAN MMXXI
MMXXI: 2021</pre>
=={{header|PL/SQL}}==
<syntaxhighlight lang="pl/sql">
/*****************************************************************
* $Author: Atanas Kebedjiev $
Line 3,665 ⟶ 5,858:
END;
</syntaxhighlight>
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
Filter FromRoman {
$output = 0
if ($_ -notmatch '^(M{1,3}|)(CM|CD|D?C{0,3}|)(XC|XL|L?X{0,3}|)(IX|IV|V?I{0,3}|)$') {
throw 'Incorrect format'
}
$current = 1000
$subtractor = 'M'
$whole = $False
$roman = $_
'C','D','X','L','I','V',' ' `
| %{
if ($whole = !$whole) {
$current /= 10
$subtractor = $_ + $subtractor[0]
$_ = $subtractor[1]
}
else {
$subtractor = $subtractor[0] + $_
}
if ($roman -match $subtractor) {
$output += $current * (4,9)[$whole]
$roman = $roman -replace $subtractor,''
}
if ($roman -match ($_ + '{1,3}')) {
$output += $current * (5,10)[$whole] * $Matches[0].Length
}
}
$output
}
</syntaxhighlight>
<syntaxhighlight lang="powershell">
'XIX','IV','','MMCDLXXIX','MMMI' | FromRoman
</syntaxhighlight>
{{Out}}
<pre>
19
4
0
2479
3001
</pre>
=={{header|Prolog}}==
<
decode_digit(v, 5).
decode_digit(x, 10).
Line 3,816 ⟶ 5,940:
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.
=={{header|Python}}==
===Imperative===
<syntaxhighlight lang="python">_rdecode = dict(zip('MDCLXVI', (1000, 500, 100, 50, 10, 5, 1)))
def decode( roman ):
Line 3,884 ⟶ 5,958:
if __name__ == '__main__':
for r in 'MCMXC MMVIII MDCLXVI'.split():
print( r, decode(r) )</
{{out}}
<pre>MCMXC 1990
Line 3,891 ⟶ 5,965:
Another version, which I believe has clearer logic:
<
('CD', 400), ('D', 500), ('CM', 900), ('M',1000))
Line 3,905 ⟶ 5,979:
for value in "MCMXC", "MMVIII", "MDCLXVI":
print('%s = %i' % (value, roman_value(value)))
</syntaxhighlight>
{{out}}
<pre>
Line 3,912 ⟶ 5,986:
MDCLXVI = 1666
</pre><!--[[User:Tonyjv|Tonyjv]] 16:29, 20 September 2011 (UTC)--> <!-- contributions not normally signed visually; info is in history -->
===Declarative===
Less clear, but a 'one liner':
<
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}}
<syntaxhighlight lang="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.
'''
dct = defaultdict(
lambda: None,
zip(
'IVXLCDM',
accumulate(chain([1], cycle([5, 2])), mul)
)
)
def go(mb, x):
'''Just a letter value added to or
subtracted from a total, or Nothing
if no letter value is defined.
'''
if None in (mb, x):
return None
else:
r, total = mb
return x, total + (-x if x < r else x)
return bindMay(reduce(
go,
[dct[k.upper()] for k in reversed(list(s))],
(0, 0)
))(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 ------------------------
# 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 None is m else mf(m)
)
# 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 None is m else (
f(m)
)
# snd :: (a, b) -> b
def snd(ab):
'''Second member of a pair.'''
return ab[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: (
f'{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()</syntaxhighlight>
{{Out}}
<pre>Roman numerals decoded:
MDCLXVI -> 1666
MCMXC -> 1990
MMVIII -> 2008
MMXVI -> 2016
MMXVIII -> 2018
MMZZIII -> (Contains unknown character)</pre>
=={{header|Quackery}}==
<syntaxhighlight lang="quackery"> [ 2dup <
if
[ dip
[ 2 * - ]
dup ]
nip dup
rot + swap ] is roman ( t p n --> t p )
[ 1 roman ] is I ( t p --> t p )
[ 5 roman ] is V ( t p --> t p )
[ 10 roman ] is X ( t p --> t p )
[ 50 roman ] is L ( t p --> t p )
[ 100 roman ] is C ( t p --> t p )
[ 500 roman ] is D ( t p --> t p )
[ 1000 roman ] is M ( t p --> t p )
[ 0 1000 rot
$ "" swap
witheach
[ space join
join ]
quackery
drop ] is ->arabic ( $ --> n )
$ " MCMXC" dup echo$ say " = " ->arabic echo cr
$ " MMVIII" dup echo$ say " = " ->arabic echo cr
$ "MDCLXVI" dup echo$ say " = " ->arabic echo cr
cr
$ "I MIX VIVID MILD MIMIC"
dup echo$ say " = " ->arabic echo cr
</syntaxhighlight>
{{Out}}
<pre> MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
I MIX VIVID MILD MIMIC = 3063</pre>
=={{header|R}}==
===version 1===
Modelled along the lines of other decode routines on this page, but using a vectorised approach
<
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
Line 3,952 ⟶ 6,176:
}
vapply(rSplit, toArabic, integer(1))
}</
Example usage:
<
===version 2===
Using built-in functionality in R
<
=={{header|Racket}}==
<syntaxhighlight lang="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)</syntaxhighlight>
=={{header|Raku}}==
(formerly Perl 6)
A non-validating version:
<syntaxhighlight lang="raku" line>sub rom-to-num($r) {
[+] gather $r.uc ~~ /
^
[
| M { take 1000 }
| CM { take 900 }
| D { take 500 }
| CD { take 400 }
| C { take 100 }
| XC { take 90 }
| L { take 50 }
| XL { take 40 }
| X { take 10 }
| IX { take 9 }
| V { take 5 }
| IV { take 4 }
| I { take 1 }
]+
$
/;
}
say "$_ => &rom-to-num($_)" for <MCMXC MDCLXVI MMVIII>;</syntaxhighlight>
{{out}}
<pre>MCMXC => 1990
MDCLXVI => 1666
MMVIII => 2008</pre>
A validating version. Also handles older forms such as 'IIXX' and "IIII".
<syntaxhighlight lang="raku" line>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 <MCMXC mdclxvi MMViii IIXX ILL>;</syntaxhighlight>
{{out}}
<pre>MCMXC => 1990
mdclxvi => 1666
MMViii => 2008
IIXX => 18
ILL => NaN</pre>
=={{header|Red}}==
===version 1===
<
Purpose: "Arabic <-> Roman numbers converter"
Author: "Didier Cadieu"
Line 3,983 ⟶ 6,279:
print roman-to-arabic "MDCCCLXXXVIII"
print roman-to-arabic "MMXVI"
</syntaxhighlight>
=={{header|REFAL}}==
<syntaxhighlight lang="refal">$ENTRY Go {
= <Prout <RomanDecode 'MCMXC'>>
<Prout <RomanDecode 'MMVIII'>>
<Prout <RomanDecode 'MDCLXVI'>>;
};
RomanDecode {
= 0;
e.D, <Upper e.D>: {
'M' e.R = <+ 1000 <RomanDecode e.R>>;
'CM' e.R = <+ 900 <RomanDecode e.R>>;
'D' e.R = <+ 500 <RomanDecode e.R>>;
'CD' e.R = <+ 400 <RomanDecode e.R>>;
'C' e.R = <+ 100 <RomanDecode e.R>>;
'XC' e.R = <+ 90 <RomanDecode e.R>>;
'L' e.R = <+ 50 <RomanDecode e.R>>;
'XL' e.R = <+ 40 <RomanDecode e.R>>;
'X' e.R = <+ 10 <RomanDecode e.R>>;
'IX' e.R = <+ 9 <RomanDecode e.R>>;
'V' e.R = <+ 5 <RomanDecode e.R>>;
'IV' e.R = <+ 4 <RomanDecode e.R>>;
'I' e.R = <+ 1 <RomanDecode e.R>>;
};
};</syntaxhighlight>
{{out}}
<pre>1990
2008
1666</pre>
=={{header|REXX}}==
Line 3,991 ⟶ 6,317:
{{Works with|ooRexx}}
<
Do
Line 4,053 ⟶ 6,379:
Return digit
End
Exit</
{{out}}
<pre>
Line 4,073 ⟶ 6,399:
:::* the '''j''' and '''u''' numerals
:::* (deep) parenthesis type Roman numbers
<
rYear = 'MCMXC' ; say right(rYear, 9)":" rom2dec(rYear)
rYear = 'mmviii' ; say right(rYear, 9)":" rom2dec(rYear)
Line 4,098 ⟶ 6,424:
if _=='D' then return 500
if _=='M' then return 1000
return 0 /*indicate an invalid Roman numeral. */</
===version 3===
Line 4,120 ⟶ 6,446:
<br>Also note that '''IIII''' is a legal Roman numeral construct; (as demonstrated by almost any old clock or
<br>"dialed" wristwatch that has Roman numerals).
<
numeric digits 1000 /*so we can handle the big numbers. */
parse arg z /*obtain optional arguments from the CL*/
Line 4,145 ⟶ 6,471:
else #=#+_ /* else add. */
end /*k*/
return # /*return Arabic number. */</
'''output''' when using the default inputs:
<pre>
Line 4,159 ⟶ 6,485:
=={{header|Ring}}==
<
symbols = "MDCLXVI"
weights = [1000,500,100,50,10,5,1]
Line 4,181 ⟶ 6,507:
next
return arabic
</syntaxhighlight>
=={{header|RPL}}==
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ DUP SIZE "IVXLCDM" { 1 5 10 50 100 500 1000 }
→ rom siz dig val
≪ 0 1 siz '''FOR''' j
rom j DUP SUB
'''IF''' dig SWAP POS '''THEN''' val LAST GET '''END'''
'''IF''' DUP2 < '''THEN''' SWAP NEG SWAP '''END'''
'''NEXT'''
0 1 siz '''START''' + '''NEXT''' +
≫ ≫ ''''ROM→'''' STO
|
'''ROM→''' ''( "ROMAN" -- n )''
store input string, length and tables
scan string from highest digit
get jth character
if char in the table then push its value into stack
if > to previous value then change sign of previous value
sum the stack
.
|}
=={{header|Ruby}}==
<
r = roman.upcase
n = 0
Line 4,210 ⟶ 6,565:
end
[ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| p r => fromRoman(r)}</
{{out}}
Line 4,219 ⟶ 6,574:
</pre>
or
<
['L', 50], ['XL', 40], ['X', 10], ['IX', 9], ['V', 5], ['IV', 4], ['I', 1] ]
Line 4,229 ⟶ 6,584:
end
[ "MCMXC", "MMVIII", "MDCLXVI" ].each {|r| puts "%8s :%5d" % [r, parseRoman(r)]}</
{{out}}
Line 4,237 ⟶ 6,592:
MDCLXVI : 1666
</pre>
=={{header|Rust}}==
<
symbol: &'static str,
value: u32
Line 4,299 ⟶ 6,628:
println!("{:2$} = {}", r, to_hindu(r), 15);
}
}</
{{out}}
<pre>MMXIV = 2014
Line 4,308 ⟶ 6,637:
=={{header|Scala}}==
<
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)
Line 4,333 ⟶ 6,662:
test("MCMXC")
test("MMVIII")
test("MDCLXVI")</
{{out}}
<pre>MCMXC => 1990
MMVIII => 2008
MDCLXVI => 1666</pre>
=={{header|Scheme}}==
Line 4,344 ⟶ 6,672:
{{works with|Gauche Scheme}}
<
(define (char-val char)
Line 4,356 ⟶ 6,684:
0 0
(map char-val (reverse (string->list roman)))))
</syntaxhighlight>
<b>Testing:</b>
<
(^s (format #t "~7d: ~d\n" s (decode s)))
'("MCMLVI" "XXC" "MCMXC" "XXCIII" "IIIIX" "MIM" "LXXIIX"))
</syntaxhighlight>
{{out}}
<pre>
Line 4,375 ⟶ 6,703:
=={{header|Seed7}}==
<
const func integer: ROMAN parse (in string: roman) is func
Line 4,410 ⟶ 6,738:
writeln(ROMAN parse "MMVIII");
writeln(ROMAN parse "MDCLXVI");
end func;</
Original source: [http://seed7.sourceforge.net/algorith/puzzles.htm#decode_roman_numerals]
{{out}}
<pre>
1990
2008
1666
</pre>
=={{header|SenseTalk}}==
<syntaxhighlight lang="sensetalk">function RomanNumeralsDecode numerals
put {
"M": 1000,
"D": 500,
"C": 100,
"L": 50,
"X": 10,
"V": 5,
"I": 1
} into values
put 0 into total
repeat with each character letter of numerals
if values.(character the counter + 1 of numerals) is less than or equal to values.(letter)
add values.(letter) to total
else
subtract values.(letter) from total
end if
end repeat
return total
end RomanNumeralsDecode</syntaxhighlight>
<syntaxhighlight lang="sensetalk">repeat for each item in [
"MCMXC",
"MMVIII",
"MDCLXVI",
]
put RomanNumeralsDecode(it)
end repeat
</syntaxhighlight>
{{out}}
<pre>
Line 4,420 ⟶ 6,787:
=={{header|Sidef}}==
<
var arabic = 0
Line 4,447 ⟶ 6,814:
%w(MCMXC MMVIII MDCLXVI).each { |roman_digit|
"%-10s == %d\n".printf(roman_digit, roman2arabic(roman_digit))
}</
{{out}}
<pre>
Line 4,456 ⟶ 6,823:
Simpler solution:
<
digit.uc.trans([
:M: '1000+',
Line 4,476 ⟶ 6,843:
%w(MCMXC MMVIII MDCLXVI).each { |roman_num|
say "#{roman_num}\t-> #{roman2arabic(roman_num)}";
}</
{{out}}
<pre>
Line 4,483 ⟶ 6,850:
MDCLXVI -> 1666
</pre>
=={{header|Simula}}==
<
INTEGER PROCEDURE FROMROMAN(S); TEXT S;
Line 4,529 ⟶ 6,897:
END PROGRAM;
</syntaxhighlight>
{{out}}
<pre>
Line 4,535 ⟶ 6,903:
ROMAN "MMVIII" => 2008
ROMAN "MDCLXVI" => 1666
</pre>
=={{header|SNOBOL4}}==
<
define('arabic(n)s,ch,val,sum,x') :(arabic_end)
arabic s = 'M1000 D500 C100 L50 X10 V5 I1 '
Line 4,625 ⟶ 6,922:
astr = astr r '=' arabic(r) ' ' :(tloop)
out output = astr
end</
{{out}}
<pre>MMX=2010 MCMXCIX=1999 MCDXCII=1492 MLXVI=1066 CDLXXVI=476</pre>
Here's an alternative version, which is maybe more SNOBOL4-idiomatic and less like one might program it in a more common language:
<
define("arabic1(romans,arabic1)rdigit,adigit,b4")
romans1 = " 0 IX9 IV4 III3 II2 I1 VIII8 VII7 VI6 V5" :(arabic1_end)
Line 4,643 ⟶ 6,940:
astr = astr r '=' arabic1(r) ' ' :(tloop)
out output = astr
end</
The output is the same as in the earlier version.
Line 4,649 ⟶ 6,946:
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.
<
define("arabic1(romans,arabic1)rdigit,adigit,b4")
romans1 = " 0 IX9 IV4 III3 II2 I1 VIII8 VII7 VI6 V5" :(arabic1_end)
Line 4,661 ⟶ 6,958:
tstr span(' ') break(' ') $ r *?(astr = astr r '=' arabic1(r) ' ') fail
output = astr
end</
=={{header|SPL}}==
<syntaxhighlight lang="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))]
? v<m, v = -v
? c>m, m = c
a += v
<
<= a
.
t = ["MMXI","MIM","MCMLVI","MDCLXVI","XXCIII","LXXIIX","IIIIX"]
> i, 1..#.size(t,1)
#.output(t[i]," = ",r2a(t[i]))
<</syntaxhighlight>
{{out}}
<pre>
MMXI = 2011
MIM = 1999
MCMLVI = 1956
MDCLXVI = 1666
XXCIII = 83
LXXIIX = 78
IIIIX = 6
</pre>
=={{header|Swift}}==
<syntaxhighlight lang="swift">extension Int {
let values = [
( "M", 1000),
("CM", 900),
var raw =
while raw.hasPrefix(digit)
}
}
}
</syntaxhighlight>
{{output}}
<syntaxhighlight lang="swift">Int(romanNumerals: "MDCLXVI") // 1666</syntaxhighlight>
=={{header|Tailspin}}==
<syntaxhighlight lang="tailspin">
def digits: [(M:1000"1"), (CM:900"1"), (D:500"1"), (CD:400"1"), (C:100"1"), (XC:90"1"), (L:50"1"), (XL:40"1"), (X:10"1"), (IX:9"1"), (V:5"1"), (IV:4"1"), (I:1"1")];
composer decodeRoman
@: 1;
[ <digit>* ] -> \(@: 0"1"; $... -> @: $@ + $; $@ !\)
rule digit: <value>* (@: $@ + 1;)
rule value: <='$digits($@)::key;'> -> $digits($@)::value
end decodeRoman
'MCMXC' -> decodeRoman -> !OUT::write
'
' -> !OUT::write
'MMVIII' -> decodeRoman -> !OUT::write
'
' -> !OUT::write
'MDCLXVI' -> decodeRoman -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
1990"1"
2008"1"
1666"1"
</pre>
=={{header|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:
<
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:
<
puts "$r\t-> [fromRoman $r]"
}</
{{out}}
<pre>MCMXC -> 1990
Line 4,747 ⟶ 7,061:
MMVIII -> 2008</pre>
=={{header|
Unix TMG dialect. Version without validation:
<syntaxhighlight lang="unixtmg">loop: parse(roman)\loop;
roman: string(!<<MDCLXVI>>) [n=0] num
letter: num/render letter;
num: <M> [n=+1750]
| <D> [n=+764]
| <C> ( <M> [n=+1604]
| <D> [n=+620]
| [n=+144] )
| <L> [n=+62]
| <X> ( <C> [n=+132]
| <L> [n=+50]
| [n=+12] )
| <V> [n=+5]
| <I> ( <X> [n=+11]
| <V> [n=+4]
| [n++] );
render: decimal(n) = { 1 * };
n: 0;</syntaxhighlight>
Unix TMG dialect. Version with validation:
<syntaxhighlight lang="unixtmg">loop: [wsz = &a - &n]
parse(line)\loop
parse(error)\loop;
line: roman *;
roman: [n=0] [off=0]
comb((<^>),(<&>),(<M>))
comb((<M>),(<D>),(<C>))
comb((<C>),(<L>),(<X>))
comb((<X>),(<V>),(<I>))
[n>0?] decimal(n) = { 1 * };
comb: proc(c1,c2,c3)
[v1 = *(wsz*off++ + &a)]
[v2 = *(wsz*off++ + &a)]
[v3 = *(wsz*off + &a)]
( c3 ( c3 ( c3 [n=+(3*v3)]
| [n=+(2*v3)] )
| c1 [v1>0?] [n=+v1-v3]
| c2 [v2>0?] [n=+v2-v3]
| [n=+v3] )
| c2 [v2>0?] [n=+v2]
( c3 ( c3 ( c3 [n=+(3*v3)]
| [n=+(2*v3)] )
| [n=+v3] )
| () )
| () );
error: smark ignore(<<>>) string(notnewline) scopy *
= { <error: > 1 * };
notnewline: !<<
>>;
n: 0;
a: 0; 0; 1750; 764; 144; 62; 12; 5; 1;
off:0;
wsz:0;
v1: 0; v2: 0; v3: 0;</syntaxhighlight>
Sample input:
<pre>MMXVI
LV
XII
MCMLIV
IIXX
IM
XXCIII</pre>
Sample output:
<pre>2016
55
12
1954
error: IIXX
error: IM
error: XXCIII</pre>
=={{header|TUSCRIPT}}==
<
LOOP roman_number="MCMXC'MMVIII'MDCLXVI"
arab_number=DECODE (roman_number,ROMAN)
PRINT "Roman number ",roman_number," equals ", arab_number
ENDLOOP</
{{out}}
<pre>
Line 4,787 ⟶ 7,151:
Roman number MDCLXVI equals 1666
</pre>
=={{header|UNIX Shell}}==
<
#!/bin/bash
Line 4,824 ⟶ 7,189:
roman_to_dec MMVIII
roman_to_dec MDCLXVI
</syntaxhighlight>
=={{header|VBA}}==
Convert Romans (i.e : XVI) in integers
<syntaxhighlight lang="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
</syntaxhighlight>
{{out}}
<pre>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</pre>
=={{header|VBScript}}==
{{trans|360 Assembly}}
<syntaxhighlight lang="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
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|Vedit macro language}}==
<
//
do {
Line 4,887 ⟶ 7,336:
Reg_Empty(11)
Buf_Quit(OK)
Return</
{{out}}
<pre>iv = 4
Line 4,894 ⟶ 7,343:
MCMXC = 1990
MMXI = 2011</pre>
=={{header|V (Vlang)}}==
{{trans|Kotlin}}
<syntaxhighlight lang="Zig">
const romans = ["I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI"]
fn main() {
for roman in romans {println("${roman:-10} = ${roman_decode(roman)}")}
}
fn roman_decode(roman string) int {
mut n := 0
mut last := "O"
if roman =="" {return n}
for c in roman {
match c.ascii_str() {
"I" {n++}
"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}}
else {last = c.ascii_str()}
}
}
return n
}
</syntaxhighlight>
{{out}}
<pre>
I = 1
III = 3
IV = 4
VIII = 8
XLIX = 49
CCII = 202
CDXXXIII = 433
MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt
var decode = Fn.new { |r|
if (r == "") return 0
var n = 0
var last = "0"
for (c in r) {
var k
if (c == "I") {
k = 1
} else if (c == "V") {
k = (last == "I") ? 3 : 5
} else if (c == "X") {
k = (last == "I") ? 8 : 10
} else if (c == "L") {
k = (last == "X") ? 30 : 50
} else if (c == "C") {
k = (last == "X") ? 80 : 100
} else if (c == "D") {
k = (last == "C") ? 300 : 500
} else if (c == "M") {
k = (last == "C") ? 800 : 1000
}
n = n + k
last = c
}
return n
}
var romans = ["I", "III", "IV", "VIII", "XLIX", "CCII", "CDXXXIII", "MCMXC", "MMVIII", "MDCLXVI"]
for (r in romans) System.print("%(Fmt.s(-10, r)) = %(decode.call(r))")</syntaxhighlight>
{{out}}
<pre>
I = 1
III = 3
IV = 4
VIII = 8
XLIX = 49
CCII = 202
CDXXXIII = 433
MCMXC = 1990
MMVIII = 2008
MDCLXVI = 1666
</pre>
=={{header|XLISP}}==
Uses basic list processing and recursion. Probably not amazingly fast, but quite concise and hopefully clear.
<
(define roman '((#\m 1000) (#\d 500) (#\c 100) (#\l 50) (#\x 10) (#\v 5) (#\i 1)))
(defun to-arabic (rn rs a)
Line 4,906 ⟶ 7,447:
(+ a (cadar rs)) ) ) )
(t (to-arabic rn (cdr rs) a)) ) )
(to-arabic (string->list r) roman 0) )</
Test it in a REPL:
<
(1990 2008 1666)</
=={{header|XPL0}}==
<
code CrLf=9, IntOut=11;
Line 4,939 ⟶ 7,480:
IntOut(0, Roman("MMVIII")); CrLf(0);
IntOut(0, Roman("MDCLXVI")); CrLf(0);
]</
{{out}}
Line 4,947 ⟶ 7,488:
1666
</pre>
=={{header|XQuery}}==
<syntaxhighlight lang="xquery">
xquery version "3.1";
declare function local:decode-roman-numeral($roman-numeral as xs:string) {
$roman-numeral
=> upper-case()
=> for-each(
function($roman-numeral-uppercase) {
analyze-string($roman-numeral-uppercase, ".")/fn:match
! map { "M": 1000, "D": 500, "C": 100, "L": 50, "X": 10, "V": 5, "I": 1 }(.)
}
)
=> fold-right([0,0],
function($number as xs:integer, $accumulator as array(*)) {
let $running-total := $accumulator?1
let $previous-number := $accumulator?2
return
if ($number lt $previous-number) then
[ $running-total - $number, $number ]
else
[ $running-total + $number, $number ]
}
)
=> array:get(1)
};
let $roman-numerals :=
map {
"MCMXCIX": 1999,
"MDCLXVI": 1666,
"XXV": 25,
"XIX": 19,
"XI": 11,
"CMLIV": 954,
"MMXI": 2011,
"CD": 400,
"MCMXC": 1990,
"MMVIII": 2008,
"MMIX": 2009,
"MMMDCCCLXXXVIII": 3888
}
return
map:for-each(
$roman-numerals,
function($roman-numeral, $expected-value) {
local:decode-roman-numeral($roman-numeral) eq $expected-value
}
)
</syntaxhighlight>
=={{header|zkl}}==
<
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),
Line 4,964 ⟶ 7,556:
}
return(value);
}</
<pre>
toArabic("MCMXC") //-->1990
Line 4,972 ⟶ 7,564:
{{omit from|GUISS}}
=={{header|Zoea}}==
<syntaxhighlight lang="zoea">
program: roman_decimal
input: 'XIII'
output: 13
</syntaxhighlight>
=={{header|Zoea Visual}}==
[http://zoea.co.uk/examples/zv-rc/Roman_numerals_decode.png Roman numerals decode]
=={{header|zsh}}==
<syntaxhighlight lang="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
</syntaxhighlight>
| |||