# Roman numerals/Encode: Difference between revisions

Roman numerals/Encode
You are encouraged to solve this task according to the task description, using any language you may know.

Create a function taking a positive integer as its parameter and returning a string containing the Roman numeral representation of that integer. Modern Roman numerals are written by expressing each digit separately, starting with the left most digit and skipping any digit with a value of zero.

In Roman numerals:

• 1990 is rendered: 1000=M, 900=CM, 90=XC; resulting in MCMXC
• 2008 is written as 2000=MM, 8=VIII; or MMVIII
• 1666 uses each Roman symbol in descending order: MDCLXVI

## 11l

Translation of: Python
V anums = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
V rnums = ‘M CM D CD C XC L XL X IX V IV I’.split(‘ ’)

F to_roman(=x)
V ret = ‘’
L(a, r) zip(:anums, :rnums)
(V n, x) = divmod(x, a)
ret ‘’= r * n
R ret

V test = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 25, 30, 40,
50, 60, 69, 70, 80, 90, 99, 100, 200, 300, 400, 500, 600, 666, 700, 800, 900, 1000,
1009, 1444, 1666, 1945, 1997, 1999, 2000, 2008, 2010, 2011, 2500, 3000, 3999]
L(val) test
print(val‘ - ’to_roman(val))

## 8080 Assembly

		org	100h
jmp	test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Takes a 16-bit integer in HL, and stores it
;; as a 0-terminated string starting at BC.
;; On exit, all registers destroyed; BC pointing at
;; end of string.
mkroman:	push	h	; put input on stack
lxi	h,mkromantab
mkromandgt:	mov	a,m	; scan ahead to next entry
ana	a
inx	h
jnz	mkromandgt
mov	a,h	; if zero, we're done
ora	l
jz	mkromandone
xthl		; load next entry from table
mov	e,m	; de = number
inx	h
mov	d,m
inx	h
xra	a	; find how many we need
subtract:	inr	a	; with trial subtraction
jc	subtract
push	psw	; keep counter
mov	a,d	; we subtracted one too many
cma		; so we need to add one back
mov	d,a
mov	a,e
cma
mov	e,a
inx	d
pop	d	; restore counter (into D)
stringouter:	dcr	d	; do we need to include one?
jz	mkromandgt
push	h	; keep string location
stringinner:	mov	a,m	; copy string into target
stax	b
ana	a	; done yet?
jz	stringdone
inx	h
inx	b	; copy next character
jmp	stringinner
stringdone:	pop	h	; restore string location
jmp	stringouter
mkromandone:	pop	d	; remove temporary variable from stack
ret
mkromantab:	db	0
db	18h,0fch,'M',0		; The value for each entry
db	7ch,0fch,'CM',0		; is stored already negated
db	0ch,0feh,'D',0		; so that it can be immediately
db	9ch,0ffh,'C',0		; This also has the convenient
db	0a6h,0ffh,'XC',0	; property of not having any
db	0ceh,0ffh,'L',0		; zero bytes except the string
db	0d8h,0ffh,'XL',0	; and row terminators.
db	0f6h,0ffh,'X',0
db	0f7h,0ffh,'IX',0
db	0fbh,0ffh,'V',0
db	0fch,0ffh,'IV',0
db	0ffh,0ffh,'I',0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test code
test:		mvi	c,10	; read string from console
lxi	d,dgtbufdef
call	5
lxi	h,0	; convert to integer
lxi	b,dgtbuf
ana	a
jz	convert
dad	h	; hl *= 10
mov	d,h
mov	e,l
sui	'0'
mov	e,a
mvi	d,0
inx	b
convert:	lxi	b,romanbuf	; convert to roman
call	mkroman
mvi	a,'$' ; switch string terminator stax b mvi c,9 ; output result lxi d,romanbuf jmp 5 nl: db 13,10,'$'
dgtbufdef:	db	5,0
dgtbuf:		ds	6
romanbuf:

## 8086 Assembly

### Main and Supporting Functions

The main program and test values: 70,1776,2021,3999,4000

	mov ax,0070h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine

mov ax,1776h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine

mov ax,2021h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine

mov ax,3999h
call EncodeRoman
mov si,offset StringRam
call PrintString
call NewLine

mov ax,4000h
call EncodeRoman
mov si,offset StringRam

ReturnToDos     ;macro that calls the int that exits dos


The EncodeRoman routine:

;ROMAN NUMERALS MODULE

EncodeRoman:
;takes a BCD value in AX and stores its Roman numeral equivalent in ram.

call UnpackBCD

cmp dh,03h
jng continue_EncodeRoman
;roman numerals only go up to 3999.
jmp errorhandler_encodeRoman_inputTooBig
continue_EncodeRoman:
mov si,offset StringRam
;using SI as destination of roman numerals.
push ax
push cx
mov ch,0
mov cl,dh					;loop counter
cmp dh,0
jz skipThousands
encodeRoman_handleThousands:
mov al,"M"
mov [ds:si],al				;store in string ram
inc si
; call PrintChar
loop encodeRoman_handleThousands
skipThousands:
pop cx
pop ax

encodeRoman_HandleHundreds:
pushall
mov bh,0
mov bl,dl  ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1	;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Hundreds:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Hund
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanHund
mov [ds:si],al	;store in ram
inc si
; call PrintChar
skipNullChar_RomanHund:
pop di
pop bx
inc di
loop getChar_Hundreds
popall

encodeRoman_HandleTens:
pushall
mov bh,0
mov bl,ah  ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1	;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Tens:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Tens
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanTens
mov [ds:si],al	;store in ram
inc si
; call PrintChar
skipNullChar_RomanTens:
pop di
pop bx
inc di
loop getChar_Tens
popall

encodeRoman_HandleOnes:
pushall
mov bh,0
mov bl,al  ;use bx as an offset into Roman_Lookup_Master
SHL bl,1
SHL bl,1	;multiply by 2, we are indexing into a table with 4 bytes per row.
mov di,offset Roman_Lookup_Master
mov cx,4
getChar_Ones:
mov al,[bx+es:di] ;get first char index
push bx
push di
mov di,offset Roman_Ones
mov bl,al
mov al,[bx+es:di]
cmp al,0
jz skipNullChar_RomanOnes
mov [ds:si],al	;store in ram
inc si
; call PrintChar
skipNullChar_RomanOnes:
pop di
pop bx
inc di
loop getChar_Ones
popall

mov al,0
mov [ds:si],al ;place a null terminator at the end of the string.
ret

errorhandler_encodeRoman_inputTooBig:
push ds
push ax
mov al,01h
mov byte ptr [ds:error_code],al
mov ax, offset EncodeRoman
mov word ptr [ds:error_routine],ax

mov si,offset Roman_Error
call PrintString
pop ax
pop ds
stc		;set carry, allowing program to branch if error occurred.
ret

Roman_Lookup_Master db 0,0,0,0	;0
db 0,0,0,1	;1
db 0,0,1,1	;2
db 0,1,1,1	;3
db 0,0,1,2	;4
db 0,0,0,2	;5
db 0,0,2,1	;6
db 0,2,1,1	;7
db 2,1,1,1	;8
db 0,0,1,3	;9

Roman_Ones	    db 0,"IVX"  ;the same pattern is used regardless of what power of 10 we're working with
Roman_Tens	    db 0,"XLC"
Roman_Hund	    db 0,"CDM"

UnpackBCD:
;converts a "packed" BCD value in AX to an "unpacked" value in DX.AX
;DX is the high byte, AX is the low byte.
;CLOBBERS DX AND AX.
mov dx,0
mov dl,ah
mov ah,0
push cx
mov cl,4
rol dx,cl
;BEFORE: DX = 00XYh
;AFTER:  DX = 0XY0h
ror dl,cl	;DX = 0X0Yh

rol ax,cl
;BEFORE: AX = 00XYh
;AFTER:  AX = 0XY0h
ror al,cl	;AX = 0X0Yh
pop cx
ret


Macros used:

pushall macro
push ax
push bx
push cx
push dx
push ds
push es
push di
;I forgot SI in this macro, but once you add it in the code stops working! So I left it out.
endm

popall macro
pop di
pop es
pop ds
pop dx
pop cx
pop bx
pop ax
endm


### Output

Output:
LXX
MDCCLXXVI
MMXXI
MMMCMXCIX


## Action!

DEFINE PTR="CARD"
CARD ARRAY arabic=[1000 900 500 400 100 90 50 40 10 9 5 4 1]
PTR ARRAY roman(13)

PROC InitRoman()
roman(0)="M" roman(1)="CM" roman(2)="D" roman(3)="CD"
roman(4)="C" roman(5)="XC" roman(6)="L" roman(7)="XL"
roman(8)="X" roman(9)="IX" roman(10)="V" roman(11)="IV" roman(12)="I"
RETURN

PROC EncodeRomanNumber(CARD n CHAR ARRAY res)
BYTE i,len
CHAR ARRAY tmp

res(0)=0 len=0
FOR i=0 TO 12
DO
WHILE arabic(i)<=n
DO
tmp=roman(i)
SAssign(res,tmp,len+1,len+1+tmp(0))
len==+tmp(0)
n==-arabic(i)
OD
OD
res(0)=len
RETURN

PROC Main()
CARD ARRAY data=[1990 2008 5555 1666 3888 3999]
BYTE i
CHAR ARRAY r(20)

InitRoman()
FOR i=0 TO 5
DO
EncodeRomanNumber(data(i),r)
PrintF("%U=%S%E",data(i),r)
OD
RETURN
Output:
1990=MCMXC
2008=MMVIII
5555=MMMMMDLV
1666=MDCLXVI
3888=MMMDCCCLXXXVIII
3999=MMMCMXCIX


## ActionScript

function arabic2roman(num:Number):String {
var lookup:Object = {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};
var roman:String = "", i:String;
for (i in lookup) {
while (num >= lookup[i]) {
roman += i;
num -= lookup[i];
}
}
return roman;
}
trace("1990 in roman is " + arabic2roman(1990));
trace("2008 in roman is " + arabic2roman(2008));
trace("1666 in roman is " + arabic2roman(1666));

Output:
1990 in roman is MCMXC
2008 in roman is MMVIII
1666 in roman is MDCLXVI


And the reverse:

function roman2arabic(roman:String):Number {
var romanArr:Array = roman.toUpperCase().split('');
var lookup:Object = {I:1, V:5, X:10, L:50, C:100, D:500, M:1000};
var num:Number = 0, val:Number = 0;
while (romanArr.length) {
val = lookup[romanArr.shift()];
num += val * (val < lookup[romanArr[0]] ? -1 : 1);
}
return num;
}
trace("MCMXC in arabic is " + roman2arabic("MCMXC"));
trace("MMVIII in arabic is " + roman2arabic("MMVIII"));
trace("MDCLXVI in arabic is " + roman2arabic("MDCLXVI"));

Output:
MCMXC in arabic is 1990
MMVIII in arabic is 2008
MDCLXVI in arabic is 1666

with Ada.Text_IO;  use Ada.Text_IO;

procedure Roman_Numeral_Test is
function To_Roman (Number : Positive) return String is
subtype Digit is Integer range 0..9;
function Roman (Figure : Digit; I, V, X : Character) return String is
begin
case Figure is
when 0 => return "";
when 1 => return "" & I;
when 2 => return I & I;
when 3 => return I & I & I;
when 4 => return I & V;
when 5 => return "" & V;
when 6 => return V & I;
when 7 => return V & I & I;
when 8 => return V & I & I & I;
when 9 => return I & X;
end case;
end Roman;
begin
pragma Assert (Number >= 1 and Number < 4000);
return
Roman (Number / 1000,       'M', ' ', ' ') &
Roman (Number / 100 mod 10, 'C', 'D', 'M') &
Roman (Number / 10 mod 10,  'X', 'L', 'C') &
Roman (Number mod 10,       'I', 'V', 'X');
end To_Roman;
begin
Put_Line (To_Roman (1999));
Put_Line (To_Roman (25));
Put_Line (To_Roman (944));
end Roman_Numeral_Test;

Output:
 MCMXCIX
XXV
CMXLIV


## ALGOL 68

Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny
Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8-8d
[]CHAR roman =        "MDCLXVmdclxvi"; # UPPERCASE for thousands #
[]INT arabic =       (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1);
[]INT adjust arabic = (100000, 100000,  10000, 10000,  1000, 1000,  100, 100,  10, 10,  1, 1, 0);

PROC arabic to roman = (INT dclxvi)STRING: (
INT in := dclxvi; # 666 #
STRING out := "";
FOR scale TO UPB roman WHILE in /= 0 DO
INT multiples = in OVER arabic[scale];
in -:= arabic[scale] * multiples;
out +:= roman[scale] * multiples;
IF in >= -adjust arabic[scale] + arabic[scale] THEN
in -:= -adjust arabic[scale] + arabic[scale];
out +:=  adjust roman[scale] +  roman[scale]
FI
OD;
out
);

main:(
[]INT test = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,25,30,40,50,60,69,70,
80,90,99,100,200,300,400,500,600,666,700,800,900,1000,1009,1444,1666,1945,1997,1999,
2000,2008,2500,3000,4000,4999,5000,6666,10000,50000,100000,500000,1000000,max int);
FOR key TO UPB test DO
INT val = test[key];
print((val, " - ", arabic to roman(val), new line))
OD
)
Output:
(last example is manually wrapped)
         +1 - i
+2 - ii
+3 - iii
+4 - iv
+5 - v
+6 - vi
+7 - vii
+8 - viii
+9 - ix
+10 - x
+11 - xi
+12 - xii
+13 - xiii
+14 - xiv
+15 - xv
+16 - xvi
+17 - xvii
+18 - xviii
+19 - xix
+20 - xx
+25 - xxv
+30 - xxx
+40 - xl
+50 - l
+60 - lx
+69 - lxix
+70 - lxx
+80 - lxxx
+90 - xc
+99 - xcix
+100 - c
+200 - cc
+300 - ccc
+400 - cd
+500 - d
+600 - dc
+666 - dclxvi
+700 - dcc
+800 - dccc
+900 - cm
+1000 - m
+1009 - mix
+1444 - mcdxliv
+1666 - mdclxvi
+1945 - mcmxlv
+1997 - mcmxcvii
+1999 - mcmxcix
+2000 - mm
+2008 - mmviii
+2500 - mmd
+3000 - mmm
+4000 - mV
+4999 - mVcmxcix
+5000 - V
+6666 - Vmdclxvi
+10000 - X
+50000 - L
+100000 - C
+500000 - D
+1000000 - M
+2147483647 - MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMCDLXXXmmmdcxlvii

## ALGOL W

Works with: awtoc version any - tested with release Mon Apr 27 14:25:27 NZST 2009
BEGIN

PROCEDURE ROMAN (INTEGER VALUE NUMBER; STRING(15) RESULT CHARACTERS; INTEGER RESULT LENGTH);
COMMENT
Returns the Roman number of an integer between 1 and 3999.
"MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000;
BEGIN
INTEGER PLACE, POWER;

PROCEDURE APPEND (STRING(1) VALUE C);
BEGIN CHARACTERS(LENGTH|1) := C; LENGTH := LENGTH + 1 END;

PROCEDURE I; APPEND(CASE PLACE OF ("I","X","C","M"));
PROCEDURE V; APPEND(CASE PLACE OF ("V","L","D"));
PROCEDURE X; APPEND(CASE PLACE OF ("X","C","M"));

ASSERT (NUMBER >= 1) AND (NUMBER < 4000);

CHARACTERS := "               ";
LENGTH := 0;
POWER := 1000;
PLACE := 4;
WHILE PLACE > 0 DO
BEGIN
CASE NUMBER DIV POWER + 1 OF BEGIN
BEGIN            END;
BEGIN I          END;
BEGIN I; I       END;
BEGIN I; I; I    END;
BEGIN I; V       END;
BEGIN V          END;
BEGIN V; I       END;
BEGIN V; I; I    END;
BEGIN V; I; I; I END;
BEGIN I; X       END
END;
NUMBER := NUMBER REM POWER;
POWER := POWER DIV 10;
PLACE := PLACE - 1
END
END ROMAN;

INTEGER I;
STRING(15) S;

ROMAN(1, S, I);    WRITE(S, I);
ROMAN(3999, S, I); WRITE(S, I);
ROMAN(3888, S, I); WRITE(S, I);
ROMAN(2009, S, I); WRITE(S, I);
ROMAN(405, S, I);  WRITE(S, I);
END.
Output:
I                           1
MMMCMXCIX                   9
MMMDCCCLXXXVIII            15
MMIX                        4
CDV                         3


## APL

Works with: Dyalog APL
toRoman←{
⍝ Digits and corresponding values
ds←((⊢≠⊃)⊆⊢)' M CM D CD C XC L XL X IX V IV I'
vs←1000, ,100 10 1∘.×9 5 4 1
⍝ Input ≤ 0 is invalid
⍵≤0:⎕SIGNAL 11
{   0=d←⊃⍸vs≤⍵:⍬    ⍝ Find highest digit in number
(d⊃ds),∇⍵-d⊃vs  ⍝ While one exists, add it and subtract from number
}⍵
}

Output:
      toRoman¨ 1990 2008 1666 2021
MCMXC  MMVIII  MDCLXVI  MMXXI 

## AppleScript

Translation of: JavaScript

(ES6 version)

(mapAccumL version)

------------------ ROMAN INTEGER STRINGS -----------------

-- roman :: Int -> String
on roman(n)
set kvs to {["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]}

on |λ|(balance, kv)
set {k, v} to kv
set {q, r} to quotRem(balance, v)
if q > 0 then
{r, concat(replicate(q, k))}
else
{r, ""}
end if
end |λ|
end script

end roman

--------------------------- TEST -------------------------
on run

map(roman, [2016, 1990, 2008, 2000, 1666])

--> {"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}
end run

---------------- GENERIC LIBRARY FUNCTIONS ---------------

-- concat :: [[a]] -> [a] | [String] -> String
on concat(xs)
script append
on |λ|(a, b)
a & b
end |λ|
end script

if length of xs > 0 and ¬
class of (item 1 of xs) is string then
set unit to ""
else
set unit to {}
end if
foldl(append, unit, xs)
end concat

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

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

-- 'The mapAccumL function behaves like a combination of map and foldl;
-- it applies a function to each element of a list, passing an
-- accumulating parameter from left to right, and returning a final
-- value of this accumulator together with the new list.' (see Hoogle)

-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
on mapAccumL(f, acc, xs)
script
on |λ|(a, x)
tell mReturn(f) to set pair to |λ|(item 1 of a, x)
[item 1 of pair, (item 2 of a) & {item 2 of pair}]
end |λ|
end script

foldl(result, [acc, {}], xs)
end mapAccumL

-- 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

--  quotRem :: Integral a => a -> a -> (a, a)
on quotRem(m, n)
{m div n, m mod n}
end quotRem

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length

-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if n < 1 then return out
set dbl to {a}

repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate

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

Output:
{"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}

## Arturo

Translation of: Nim
nums: [[1000 "M"] [900 "CM"] [500 "D"] [400 "CD"] [100 "C"] [90 "XC"]
[50 "L"] [40 "XL"] [10 "X"] [9 "IX"] [5 "V"] [4 "IV"] [1 "I"])

toRoman: function [x][
ret: ""
idx: 0
initial: x
loop nums 'num [
d: num\0
l: num\1

i: 0
while [i<initial/d] [
ret: ret ++ l
i: i+1
]

initial: mod initial d
]
return ret
]

loop [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 25 30 40
50 60 69 70 80 90 99 100 200 300 400 500 600 666 700 800 900
1000 1009 1444 1666 1945 1997 1999 2000 2008 2010 2011 2500
3000 3999] 'n
-> print [n "->" toRoman n]

Output:
1 -> I
2 -> II
3 -> III
4 -> IV
5 -> V
6 -> VI
7 -> VII
8 -> VIII
9 -> IX
10 -> X
11 -> XI
12 -> XII
13 -> XIII
14 -> XIV
15 -> XV
16 -> XVI
17 -> XVII
18 -> XVIII
19 -> XIX
20 -> XX
25 -> XXV
30 -> XXX
40 -> XL
50 -> L
60 -> LX
69 -> LXIX
70 -> LXX
80 -> LXXX
90 -> XC
99 -> XCIX
100 -> C
200 -> CC
300 -> CCC
400 -> CD
500 -> D
600 -> DC
666 -> DCLXVI
700 -> DCC
800 -> DCCC
900 -> CM
1000 -> M
1009 -> MIX
1444 -> MCDXLIV
1666 -> MDCLXVI
1945 -> MCMXLV
1997 -> MCMXCVII
1999 -> MCMXCIX
2000 -> MM
2008 -> MMVIII
2010 -> MMX
2011 -> MMXI
2500 -> MMD
3000 -> MMM
3999 -> MMMCMXCIX

## AutoHotkey

Translation of: C++
MsgBox % stor(444)

stor(value)
{
romans = M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I
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
Loop, Parse, romans, ,
{
While, value >= %A_LoopField%
{
result .= A_LoopField
value := value - (%A_LoopField%)
}
}
Return result . "O"
}


## Autolisp

(defun c:roman() (romanNumber (getint "\n Enter number > "))
(defun romanNumber (n / uni dec hun tho nstr strlist nlist rom)
(if (and (> n 0) (<= n 3999))
(progn
(setq
UNI (list "" "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX")
DEC (list "" "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC")
HUN (list "" "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM")
THO (list "" "M" "MM" "MMM")
nstr (itoa n)
)
(while (> (strlen nstr) 0) (setq strlist (append strlist (list (substr nstr 1 1))) nstr (substr nstr 2 (strlen nstr))))
(setq nlist (mapcar 'atoi strlist))
(cond
((> n 999)(setq rom(strcat(nth (car nlist) THO)(nth (cadr nlist) HUN)(nth (caddr nlist) DEC) (nth (last nlist)UNI ))))
((and (> n 99)(<= n 999))(setq rom(strcat (nth (car nlist) HUN)(nth (cadr nlist) DEC) (nth (last nlist)UNI ))))
((and (> n 9)(<= n 99))(setq rom(strcat (nth (car nlist) DEC) (nth (last nlist)UNI ))))
((<= n 9)(setq rom(nth (last nlist)UNI)))
)
)
(princ "\nNumber out of range!")
)
rom
)
Output:
1577 "MDLXXVII"
3999 "MMMCMXCIX"
888 "DCCCLXXXVIII"
159 "CLIX"


## AWK

# syntax: GAWK -f ROMAN_NUMERALS_ENCODE.AWK
BEGIN {
leng = split("1990 2008 1666",arr," ")
for (i=1; i<=leng; i++) {
n = arr[i]
printf("%s = %s\n",n,dec2roman(n))
}
exit(0)
}
function dec2roman(number,  v,w,x,y,roman1,roman10,roman100,roman1000) {
number = int(number) # force to integer
if (number < 1 || number > 3999) { # number is too small | big
return
}
split("I II III IV V VI VII VIII IX",roman1," ")   # 1 2 ... 9
split("X XX XXX XL L LX LXX LXXX XC",roman10," ")  # 10 20 ... 90
split("C CC CCC CD D DC DCC DCCC CM",roman100," ") # 100 200 ... 900
split("M MM MMM",roman1000," ")                    # 1000 2000 3000
v = (number - (number % 1000)) / 1000
number = number % 1000
w = (number - (number % 100)) / 100
number = number % 100
x = (number - (number % 10)) / 10
y = number % 10
return(roman1000[v] roman100[w] roman10[x] roman1[y])
}

Output:
1990 = MCMXC
2008 = MMVIII
1666 = MDCLXVI


## BASIC

### Applesoft BASIC

 1 N = 1990: GOSUB 5: PRINT N" = "V$2 N = 2008: GOSUB 5: PRINT N" = "V$
3 N = 1666: GOSUB 5: PRINT N" = "V$; 4 END 5 V = N:V$ = "": FOR I = 0 TO 12: FOR L = 1 TO 0 STEP 0:A =  VAL ( MID$("1E3900500400100+90+50+40+10+09+05+04+01",I * 3 + 1,3)) 6 L = (V - A) > = 0:V$ = V$+ MID$ ("M.CMD.CDC.XCL.XLX.IXV.IVI",I * 2 + 1,(I -  INT (I / 2) * 2 + 1) * L):V = V - A * L: NEXT L,I
7  RETURN


### ASIC

Translation of: DWScript
REM Roman numerals/Encode
DIM Weights(12)
DIM Symbols$(12) DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC", 50, "L" DATA 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I" REM 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded REM with these symbols. FOR J = 0 TO 12 READ Weights(J) READ Symbols$(J)
NEXT J

AValue = 1990
GOSUB ToRoman:
PRINT Roman$REM MCMXC AValue = 2022 GOSUB ToRoman: PRINT Roman$
REM MMXXII
AValue = 3888
GOSUB ToRoman:
PRINT Roman$REM MMMDCCCLXXXVIII END ToRoman: REM Result: Roman$
Roman$= "" I = 0 Loop: IF (I > 12 THEN ExitToRoman: IF AValue <= 0 THEN ExitToRoman: WHILE AValue >= Weights(I) Roman$ = Roman$+ Symbols$(I)
AValue = AValue - Weights(I)
WEND
I = I + 1
GOTO Loop:
ExitToRoman:
RETURN


### BaCon

OPTION BASE 1

GLOBAL roman$[] = { "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" } GLOBAL number[] = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 } FUNCTION toroman$(value)

LOCAL result$DOTIMES UBOUND(number) WHILE value >= number[_] result$ = result$& roman$[_]
DECR value, number[_]
WEND
DONE

RETURN result$ENDFUNC PRINT toroman$(1990)
PRINT toroman$(2008) PRINT toroman$(1666)
Output:
MCMXC
MMVIII
MDCLXVI


### BASIC256

Works with: BASIC256

print 1666+" = "+convert$(1666) print 2008+" = "+convert$(2008)
print 1001+" = "+convert$(1001) print 1999+" = "+convert$(1999)

function convert$(value) convert$=""
arabic = {1000, 900, 500, 400, 100, 90, 50,  40,  10,  9,  5,   4,  1 }
roman$= {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"} for i = 0 to 12 while value >= arabic[i] convert$ += roman$[i] value = value - arabic[i] end while next i end function Output: 1666 = MDCLXVI 2008 = MMVIII 1001 = MI 1999 = MCMXCIX  ### BBC BASIC  PRINT ;1999, FNroman(1999) PRINT ;2012, FNroman(2012) PRINT ;1666, FNroman(1666) PRINT ;3888, FNroman(3888) END DEF FNroman(n%) LOCAL i%, r$, arabic%(), roman$() DIM arabic%(12), roman$(12)
arabic%() = 1,   4,   5,   9,  10,  40,  50,  90, 100, 400, 500, 900,1000
roman$() = "I","IV", "V","IX", "X","XL", "L","XC", "C","CD", "D","CM", "M" FOR i% = 12 TO 0 STEP -1 WHILE n% >= arabic%(i%) r$ += roman$(i%) n% -= arabic%(i%) ENDWHILE NEXT = r$

Output:
1999      MCMXCIX
2012      MMXII
1666      MDCLXVI
3888      MMMDCCCLXXXVIII


### Commodore BASIC

Works with: Commodore BASIC version 7.0

C-128 version:

100 DIM RN$(12),NV(12) 110 FOR I=0 TO 12 120 : READ RN$(I), NV(I)
130 NEXT I
140 DATA M,1000, CM,900, D,500, CD,400
150 DATA C, 100, XC, 90, L, 50, XL, 40
160 DATA X,  10, IX,  9, V,  5, IV,  4
170 DATA I,   1
180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18);
190 PRINT "*****    ROMAN NUMERAL ENCODER     *****";CHR$(27);"T" 200 DO 210 : PRINT "ENTER NUMBER (0 TO QUIT):"; 220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT
230 : AN=VAL(AN$):IF AN=0 THEN EXIT 240 : RN$=""
250 : DO WHILE AN > 0
260 :   FOR I=0 TO 12
270 :     IF AN >= NV(I) THEN BEGIN
280 :       RN$= RN$+ RN$(I) 290 : AN = AN - NV(I) 300 : GOTO 330 310 : BEND 320 : NEXT I 330 : LOOP 340 : PRINT RN$;CHR$(13) 350 LOOP  Works with: Commodore BASIC version 3.5 C-16/116/Plus-4 version (BASIC 3.5 has DO/LOOP but not BEGIN/BEND) 100 DIM RN$(12),NV(12)
110 FOR I=0 TO 12
120 : READ RN$(I), NV(I) 130 NEXT I 140 DATA M,1000, CM,900, D,500, CD,400 150 DATA C, 100, XC, 90, L, 50, XL, 40 160 DATA X, 10, IX, 9, V, 5, IV, 4 170 DATA I, 1 180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18); 190 PRINT "***** ROMAN NUMERAL ENCODER *****";CHR$(27);"T"
200 DO
210 : PRINT "ENTER NUMBER (0 TO QUIT):";
220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT 230 : AN=VAL(AN$):IF AN=0 THEN EXIT
240 : RN$="" 250 : DO WHILE AN > 0 260 : FOR I=0 TO 12 270 : IF AN < NV(I) THEN 320 280 : RN$ = RN$+ RN$(I)
290 :     AN = AN - NV(I)
300 :     I = 12
320 :   NEXT I
330 : LOOP
340 : PRINT RN$;CHR$(13)
350 LOOP

Works with: Commodore BASIC version 2.0

This version works on any Commodore, though the title banner should be adjusted to match the color and screen width of the particular machine.

100 DIM RN$(12),NV(12) 110 FOR I=0 TO 12 120 : READ RN$(I), NV(I)
130 NEXT I
140 DATA M,1000, CM,900, D,500, CD,400
150 DATA C, 100, XC, 90, L, 50, XL, 40
160 DATA X,  10, IX,  9, V,  5, IV,  4
170 DATA I,   1
180 PRINT CHR$(19);CHR$(19);CHR$(147);CHR$(18);
190 PRINT "*****    ROMAN NUMERAL ENCODER     *****";
200 REM BEGIN MAIN LOOP
210 : PRINT "NUMBER (0 TO QUIT):";
220 : OPEN 1,0:INPUT#1,AN$:CLOSE 1:PRINT 230 : AN=VAL(AN$):IF AN=0 THEN END
240 : RN$="" 250 : IF AN <= 0 THEN 340 260 : FOR I=0 TO 12 270 : IF AN < NV(I) THEN 320 280 : RN$ = RN$+ RN$(I)
290 :     AN = AN - NV(I)
300 :     I = 12
320 :   NEXT I
330 : GOTO 250
340 : PRINT RN$;CHR$(13)
350 GOTO 210


The output is the same for all the above versions:

Output:
*****    ROMAN NUMERAL ENCODER     *****

ENTER NUMBER (0 TO QUIT):2009
MMIX

ENTER NUMBER (0 TO QUIT):1666
MDCLXVI

ENTER NUMBER (0 TO QUIT):3888
MMMDCCCLXXXVIII

ENTER NUMBER (0 TO QUIT):0

READY.

### FreeBASIC

Works with: FreeBASIC
DIM SHARED arabic(0 TO 12) AS Integer  => {1000, 900, 500, 400, 100, 90, 50,  40,  10,  9,  5,   4,  1 }
DIM SHARED  roman(0 TO 12) AS String*2 => {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}

FUNCTION toRoman(value AS Integer) AS String
DIM i 	AS Integer
DIM result  AS String

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

'Testing
PRINT "2009 = "; toRoman(2009)
PRINT "1666 = "; toRoman(1666)
PRINT "3888 = "; toRoman(3888)

Output:
 2009 = MMIX
1666 = MDCLXVI
3888 = MMMDCCCLXXXVIII


Another solution:

' FB 1.05.0 Win64

Function romanEncode(n As Integer) As String
If n < 1 OrElse n > 3999 Then Return "" '' can only encode numbers in range 1 to 3999
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 thousands, hundreds, tens, units
thousands = n \ 1000
n Mod= 1000
hundreds = n \ 100
n Mod= 100
tens = n \ 10
units = n Mod 10
Dim roman As String = ""
If thousands > 0  Then roman += roman1(3 - thousands)
If hundreds > 0   Then roman += roman2(9 - hundreds)
If tens > 0       Then roman += roman3(9 - tens)
If units > 0      Then roman += roman4(9 - units)
Return roman
End Function

Dim a(2) As Integer = {1990, 2008, 1666}
For i As Integer = 0 To 2
Print a(i); " => "; romanEncode(a(i))
Next

Print
Print "Press any key to quit"
Sleep

Output:
 1990 => MCMXC
2008 => MMVIII
1666 => MDCLXVI


### FutureBasic

window 1

local fn DecimaltoRoman( decimal as short ) as Str15
short arabic(12)
Str15 roman(12)
long  i
Str15 result : result = ""

arabic(0) = 1000 : arabic(1) = 900 : arabic(2) = 500 : arabic(3) = 400
arabic(4) = 100  : arabic(5) = 90  : arabic(6) = 50  : arabic(7)  = 40
arabic(8) = 10   : arabic(9) = 9   : arabic(10) = 5  : arabic(11) = 4: arabic(12) = 1

roman(0) = "M" : roman(1) = "CM" : roman(2) = "D"  : roman(3)  = "CD"
roman(4) = "C" : roman(5) = "XC" : roman(6) = "L"  : roman(7)  = "XL"
roman(8) = "X" : roman(9) = "IX" : roman(10) = "V" : roman(11) = "IV" : roman(12) = "I"

for i = 0 to 12
while ( decimal >= arabic(i) )
result = result + roman(i)
decimal = decimal - arabic(i)
wend
next i
if result == "" then result = "Zepherium"
end fn = result

print "1990 = "; fn DecimaltoRoman( 1990 )
print "2008 = "; fn DecimaltoRoman( 2008 )
print "2016 = "; fn DecimaltoRoman( 2016 )
print "1666 = "; fn DecimaltoRoman( 1666 )
print "3888 = "; fn DecimaltoRoman( 3888 )
print "1914 = "; fn DecimaltoRoman( 1914 )
print "1000 = "; fn DecimaltoRoman( 1000 )
print " 513 = "; fn DecimaltoRoman(  513 )
print "  33 = "; fn DecimaltoRoman(   33 )

HandleEvents

Output:

1990 = MCMXC
2008 = MMVIII
2016 = MMXVI
1666 = MDCLXVI
3888 = MMMDCCCLXXXVIII
1914 = MCMXIV
1000 = M
513 = DXIII
33 = XXXIII


### GW-BASIC

Translation of: DWScript
Works with: BASICA

10 REM Roman numerals/Encode
20 DIM WEIGHTS%(12), SYMBOLS$(12) 30 FOR J% = 0 TO 12: READ WEIGHTS%(J%), SYMBOLS$(J%): NEXT J%
40 DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"
50 DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"
60 REM 3888 or MMMDCCCLXXXVIII (15 chars) is
70 REM the longest string properly encoded
80 REM with these symbols.
90 AVALUE% = 1990: GOSUB 1000: PRINT ROMAN$' MCMXC 100 AVALUE% = 2022: GOSUB 1000: PRINT ROMAN$ ' MMXXII
110 AVALUE% = 3888: GOSUB 1000: PRINT ROMAN$' MMMDCCCLXXXVIII 120 END 990 REM Encode to roman 1000 ROMAN$ = "": I% = 0
1010 WHILE (I% <= 12) AND (AVALUE% > 0)
1020  WHILE AVALUE% >= WEIGHTS%(I%)
1030   ROMAN$= ROMAN$ + SYMBOLS$(I%) 1040 AVALUE% = AVALUE% - WEIGHTS%(I%) 1050 WEND 1060 I% = I% + 1 1070 WEND 1080 RETURN  Output: MCMXC MMXXII MMMDCCCLXXXVIII  ### IS-BASIC 100 PROGRAM "Roman.bas" 110 DO 120 PRINT :INPUT PROMPT "Enter an arabic number: ":N 130 IF N<1 THEN EXIT DO 140 PRINT TOROMAN$(N)
150 LOOP
160 DEF TOROMAN$(X) 170 IF X>3999 THEN 180 LET TOROMAN$="Too big."
190     EXIT DEF
200   END IF
210   RESTORE
220   LET SUM$="" 230 FOR I=1 TO 13 240 READ ARABIC,ROMAN$
250     DO WHILE X>=ARABIC
260       LET SUM$=SUM$&ROMAN$270 LET X=X-ARABIC 280 LOOP 290 NEXT 300 LET TOROMAN$=SUM$310 END DEF 320 DATA 1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC" 330 DATA 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I" ### Liberty BASIC Works with: Just BASIC  dim arabic( 12) for i =0 to 12 read k arabic( i) =k next i data 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 dim roman$( 12)
for i =0 to 12
read k$roman$( i) =k$next i data "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" print 2009, toRoman$( 2009)
print 1666, toRoman$( 1666) print 3888, toRoman$( 3888)

end

function toRoman$( value) i =0 result$ =""
for i = 0 to 12
while value >=arabic( i)
result$= result$ + roman$( i) value = value - arabic( i) wend next i toRoman$ =result$end function 2009 MMIX 1666 MDCLXVI 3888 MMMDCCCLXXXVIII  ### Microsoft Small Basic Translation of: DWScript arabicNumeral = 1990 ConvertToRoman() TextWindow.WriteLine(romanNumeral) 'MCMXC arabicNumeral = 2018 ConvertToRoman() TextWindow.WriteLine(romanNumeral) 'MMXVIII arabicNumeral = 3888 ConvertToRoman() TextWindow.WriteLine(romanNumeral) 'MMMDCCCLXXXVIII Sub ConvertToRoman weights[0] = 1000 weights[1] = 900 weights[2] = 500 weights[3] = 400 weights[4] = 100 weights[5] = 90 weights[6] = 50 weights[7] = 40 weights[8] = 10 weights[9] = 9 weights[10] = 5 weights[11] = 4 weights[12] = 1 symbols[0] = "M" symbols[1] = "CM" symbols[2] = "D" symbols[3] = "CD" symbols[4] = "C" symbols[5] = "XC" symbols[6] = "L" symbols[7] = "XL" symbols[8] = "X" symbols[9] = "IX" symbols[10] = "V" symbols[11] = "IV" symbols[12] = "I" romanNumeral = "" i = 0 While (i <= 12) And (arabicNumeral > 0) While arabicNumeral >= weights[i] romanNumeral = Text.Append(romanNumeral, symbols[i]) arabicNumeral = arabicNumeral - weights[i] EndWhile i = i + 1 EndWhile EndSub Output: MCMXC MMXVIII MMMDCCCLXXXVIII  ### Nascom BASIC Translation of: DWScript Works with: Nascom ROM BASIC version 4.7 10 REM Roman numerals/Encode 20 DIM WEIGHTS(12),SYMBOLS$(12)
30 FOR I=0 TO 12
40 READ WEIGHTS(I),SYMBOLS$(I) 50 NEXT I 60 DATA 1000,M,900,CM,500,D,400,CD,100,C,90,XC 70 DATA 50,L,40,XL,10,X,9,IX,5,V,4,IV,1,I 80 REM ** 3888 or MMMDCCCLXXXVIII (15 chars) is 90 REM the longest string properly encoded 100 REM with these symbols. 110 V=1990:GOSUB 500 120 PRINT ROMAN$:REM MCMXC
130 V=2022:GOSUB 500
140 PRINT ROMAN$:REM MMXXII 150 V=3888:GOSUB 500 160 PRINT ROMAN$:REM MMMDCCCLXXXVIII
170 END
490 REM ** Encode to roman
500 ROMAN$="" 510 I=0 520 IF I>12 OR V<=0 THEN RETURN 530 IF V<WEIGHTS(I) THEN 570 540 ROMAN$=ROMAN$+SYMBOLS$(I)
550 V=V-WEIGHTS(I)
560 GOTO 530
570 I=I+1
580 GOTO 520
590 RETURN

Output:
MCMXC
MMXXII
MMMDCCCLXXXVIII


### PowerBASIC

Translation of: BASIC
Works with: PB/Win version 8+
Works with: PB/CC version 5
FUNCTION toRoman(value AS INTEGER) AS STRING
DIM arabic(0 TO 12) AS INTEGER
DIM roman(0 TO 12) AS STRING
ARRAY ASSIGN arabic() = 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1
ARRAY ASSIGN roman() = "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"

DIM i AS INTEGER
DIM result AS STRING

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

FUNCTION PBMAIN
'Testing
? "2009 = " & toRoman(2009)
? "1666 = " & toRoman(1666)
? "3888 = " & toRoman(3888)
END FUNCTION

### PureBasic

#SymbolCount = 12 ;0 based count
DataSection
denominations:
Data.s "M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I" ;0-12

denomValues:
Data.i  1000,900,500,400,100,90,50,40,10,9,5,4,1 ;values in decending sequential order
EndDataSection

;-setup
Structure romanNumeral
symbol.s
value.i
EndStructure

Global Dim refRomanNum.romanNumeral(#SymbolCount)

Restore denominations
For i = 0 To #SymbolCount
Next

Restore denomValues
For i = 0 To #SymbolCount
Next

Procedure.s decRoman(n)
;converts a decimal number to a roman numeral
Protected roman$, i For i = 0 To #SymbolCount Repeat If n >= refRomanNum(i)\value roman$ + refRomanNum(i)\symbol
n - refRomanNum(i)\value
Else
Break
EndIf
ForEver
Next

ProcedureReturn roman$EndProcedure If OpenConsole() PrintN(decRoman(1999)) ;MCMXCIX PrintN(decRoman(1666)) ;MDCLXVI PrintN(decRoman(25)) ;XXV PrintN(decRoman(954)) ;CMLIV Print(#CRLF$ + #CRLF$+ "Press ENTER to exit") Input() CloseConsole() EndIf  ### QBasic DIM SHARED arabic(0 TO 12) DIM SHARED roman$(0 TO 12)

FUNCTION toRoman$(value) LET result$ = ""
FOR i = 0 TO 12
DO WHILE value >= arabic(i)
LET result$= result$ + roman$(i) LET value = value - arabic(i) LOOP NEXT i toRoman$ = result$END FUNCTION FOR i = 0 TO 12 READ arabic(i), roman$(i)
NEXT i

DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"
DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V",  4, "IV", 1, "I"

'Testing
PRINT "2009 = "; toRoman$(2009) PRINT "1666 = "; toRoman$(1666)
PRINT "3888 = "; toRoman$(3888)  ### Run BASIC [loop] input "Input value:";val$
print roman$(val$)
goto [loop]

' ------------------------------
' Roman numerals
' ------------------------------
FUNCTION roman$(val$)
a2r$= "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" v = val(val$)
for i = 1 to 13
r$= word$(a2r$,i,",") a = val(word$(r$,2,":")) while v >= a roman$ = roman$+ word$(r$,1,":") v = v - a wend next i END FUNCTION ### TI-83 BASIC PROGRAM:DEC2ROM :"="→Str1 :Lbl ST :ClrHome :Disp "NUMBER TO" :Disp "CONVERT:" :Input A :If fPart(A) or A≠abs(A) :Then :Goto PI :End :A→B :While B≥1000 :Str1+"M"→Str1 :B-1000→B :End :If B≥900 :Then :Str1+"CM"→Str1 :B-900→B :End :If B≥500 :Then :Str1+"D"→Str1 :B-500→B :End :If B≥400 :Then :Str1+"CD"?Str1 :B-400→B :End :While B≥100 :Str1+"C"→Str1 :B-100→B :End :If B≥90 :Then :Str1+"XC"→Str1 :B-90→B :End :If B≥50 :Then :Str1+"L"→Str1 :B-50→B :End :If B≥40 :Then :Str1+"XL"→Str1 :B-40→B :End :While B≥10 :Str1+"X"→Str1 :B-10→B :End :If B≥9 :Then :Str1+"IX"→Str1 :B-9→B :End :If B≥5 :Then :Str1+"V"→Str1 :B-5→B :End :If B≥4 :Then :Str1+"IV"→Str1 :B-4→B :End :While B>0 :Str1+"I"→Str1 :B-1→B :End :ClrHome :Disp A :Disp Str1 :Stop :Lbl PI :ClrHome :Disp "THE NUMBER MUST" :Disp "BE A POSITIVE" :Disp "INTEGER." :Pause :Goto ST ### True BASIC OPTION BASE 0 DIM arabic(12), roman$(12)

FOR i = 0 to 12
READ arabic(i), roman$(i) NEXT i DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC" DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I" FUNCTION toRoman$(value)
LET result$= "" FOR i = 0 TO 12 DO WHILE value >= arabic(i) LET result$ = result$& roman$(i)
LET value = value - arabic(i)
LOOP
NEXT i
LET toRoman$= result$
END FUNCTION

!Testing
PRINT "2009 = "; toRoman$(2009) PRINT "1666 = "; toRoman$(1666)
PRINT "3888 = "; toRoman$(3888) END  ### uBasic/4tH Translation of: BBC Basic Push 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000 ' Initialize array For i = 12 To 0 Step -1 @(i) = Pop() Next ' Calculate and print numbers Print 1999, : Proc _FNroman (1999) Print 2014, : Proc _FNroman (2014) Print 1666, : Proc _FNroman (1666) Print 3888, : Proc _FNroman (3888) End _FNroman Param (1) ' ( n --) Local (1) ' Define b@ ' Try all numbers in array For b@ = 12 To 0 Step -1 Do While a@ > @(b@) - 1 ' Several occurences of same number? GoSub ((b@ + 1) * 10) ' Print roman digit a@ = a@ - @(b@) ' Decrement number Loop Next Print ' Terminate line Return ' Print roman digits 10 Print "I"; : Return 20 Print "IV"; : Return 30 Print "V"; : Return 40 Print "IX"; : Return 50 Print "X"; : Return 60 Print "XL"; : Return 70 Print "L"; : Return 80 Print "XC"; : Return 90 Print "C"; : Return 100 Print "CD"; : Return 110 Print "D"; : Return 120 Print "CM"; : Return 130 Print "M"; : Return  ### Visual Basic Translation of: BASIC Function toRoman(value) As String Dim arabic As Variant Dim roman As Variant 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") Dim i As Integer, result As String 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 Sub Main() MsgBox toRoman(Val(InputBox("Number, please"))) End Sub  ### XBasic Translation of: DWScript Works with: Windows XBasic PROGRAM "romanenc" VERSION "0.0000" DECLARE FUNCTION Entry() INTERNAL FUNCTION ToRoman$(aValue%%)

' 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded with these symbols.

FUNCTION Entry()
PRINT ToRoman$(1990) ' MCMXC PRINT ToRoman$(2018) ' MMXVIII
PRINT ToRoman$(3888) ' MMMDCCCLXXXVIII END FUNCTION FUNCTION ToRoman$(aValue%%)
DIM weights%%[12]
DIM symbols$[12] weights%%[0] = 1000 weights%%[1] = 900 weights%%[2] = 500 weights%%[3] = 400 weights%%[4] = 100 weights%%[5] = 90 weights%%[6] = 50 weights%%[7] = 40 weights%%[8] = 10 weights%%[9] = 9 weights%%[10] = 5 weights%%[11] = 4 weights%%[12] = 1 symbols$[0] = "M"
symbols$[1] = "CM" symbols$[2] = "D"
symbols$[3] = "CD" symbols$[4] = "C"
symbols$[5] = "XC" symbols$[6] = "L"
symbols$[7] = "XL" symbols$[8] = "X"
symbols$[9] = "IX" symbols$[10] = "V"
symbols$[11] = "IV" symbols$[12] = "I"

destination$= "" i@@ = 0 DO WHILE (i@@ <= 12) AND (aValue%% > 0) DO WHILE aValue%% >= weights%%[i@@] destination$ = destination$+ symbols$[i@@]
aValue%% = aValue%% - weights%%[i@@]
LOOP
i@@ = i@@ + 1
LOOP
RETURN destination$END FUNCTION END PROGRAM  Output: MCMXC MMXVIII MMMDCCCLXXXVIII  ### Yabasic roman$ = "M, CM, D, CD, C, XC, L, XL, X, IX, V, IV, I"
decml$= "1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1" sub toRoman$(value)
local res$, i, roman$(1), decml$(1), long long = token(roman$, roman$(), ", ") long = token(decml$, decml$(), ", ") for i=1 to long while(value >= val(decml$(i)))
res$= res$ + roman$(i) value = value - val(decml$(i))
wend
next i
return res$end sub print 400, " ", toRoman$(400)
print 1990, " ", toRoman$(1990) print 2008, " ", toRoman$(2008)
print 2009, " ", toRoman$(2009) print 1666, " ", toRoman$(1666)
print 3888, " ", toRoman$(3888) //Output: // 400 = CD // 1990 = MCMXC // 2008 = MMVIII // 2009 = MMIX // 1666 = MDCLXVI // 3888 = MMMDCCCLXXXVIII ### ZX Spectrum Basic  10 DATA 1000,"M",900,"CM" 20 DATA 500,"D",400,"CD" 30 DATA 100,"C",90,"XC" 40 DATA 50,"L",40,"XL" 50 DATA 10,"X",9,"IX" 60 DATA 5,"V",4,"IV",1,"I" 70 INPUT "Enter an arabic number: ";V 80 LET VALUE=V 90 LET V$=""
100 FOR I=0 TO 12
110 READ A,R$120 IF V<A THEN GO TO 160 130 LET V$=V$+R$
140 LET V=V-A
150 GO TO 120
160 NEXT I
170 PRINT VALUE;"=";V$ ## Batch File Translation of: BASIC @echo off setlocal enabledelayedexpansion set cnt=0&for %%A in (1000,900,500,400,100,90,50,40,10,9,5,4,1) do (set arab!cnt!=%%A&set /a cnt+=1) set cnt=0&for %%R in (M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I) do (set rom!cnt!=%%R&set /a cnt+=1) ::Testing call :toRoman 2009 echo 2009 = !result! call :toRoman 1666 echo 1666 = !result! call :toRoman 3888 echo 3888 = !result! pause>nul exit/b 0 ::The "function"... :toRoman set value=%1 set result= for /l %%i in (0,1,12) do ( set a=%%i call :add_val ) goto :EOF :add_val if !value! lss !arab%a%! goto :EOF set result=!result!!rom%a%! set /a value-=!arab%a%! goto add_val  Output: 2009 = MMIX 1666 = MDCLXVI 3888 = MMMDCCCLXXXVIII ## BCPL get "libhdr" let toroman(n, v) = valof$(  let extract(n, val, rmn, v) = valof
$( while n >= val$(  n := n - val;
for i=1 to rmn%0 do v%(v%0+i) := rmn%i
v%0 := v%0 + rmn%0
$) resultis n$)

v%0 := 0
n := extract(n, 1000, "M",  v)
n := extract(n,  900, "CM", v)
n := extract(n,  500, "D",  v)
n := extract(n,  400, "CD", v)
n := extract(n,  100, "C",  v)
n := extract(n,   90, "XC", v)
n := extract(n,   50, "L",  v)
n := extract(n,   40, "XL", v)
n := extract(n,   10, "X",  v)
n := extract(n,    9, "IX", v)
n := extract(n,    5, "V",  v)
n := extract(n,    4, "IV", v)
n := extract(n,    1, "I",  v)
resultis v
$) let show(n) be$(  let v = vec 50
writef("%I4 = %S*N", n, toroman(n, v))
$) let start() be$(  show(1666)
show(2008)
show(1001)
show(1999)
show(3888)
show(2021)
$) Output: 1666 = MDCLXVI 2008 = MMVIII 1001 = MI 1999 = MCMXCIX 3888 = MMMDCCCLXXXVIII 2021 = MMXXI ## Befunge Reads the number to convert from standard input. No range validation is performed. &>0\0>00p:#v_$ >:#,_ $@ 4-v >5+#:/#<\55+%:5/\5%: vv_$9+00g+5g\00g8+>5g\00
g>\20p>:10p00g \#v _20gv
> 2+ v^-1g01\g5+8<^ +9 _
IVXLCDM

Output:
1666
MDCLXVI

## BQN

Translation of: APL
⟨ToRoman⇐R⟩ ← {
ds ← 1↓¨(¯1+⊏⊸=)⊸⊔" I IV V IX X XL L XC C CD D CM M"
vs ← 1e3∾˜ ⥊1‿4‿5‿9×⌜˜10⋆↕3
R ⇐ {
𝕨𝕊0: "";
(⊑⟜ds∾·𝕊𝕩-⊑⟜vs) 1-˜⊑vs⍋𝕩
}
}
Example use:
   ToRoman¨ 1990‿2008‿1666‿2021
⟨ "MCMXC" "MMVIII" "MDCLXVI" "MMXXI" ⟩


## Bracmat

( ( encode
=   indian roman cifr tenfoldroman letter tenfold
.   !arg:#?indian
& :?roman
&   whl
' ( @(!indian:#%?cifr ?indian)
& :?tenfoldroman
&   whl
' ( !roman:%?letter ?roman
&     !tenfoldroman
(       (I.X)
(V.L)
(X.C)
(L.D)
(C.M)
: ? (!letter.?tenfold) ?
& !tenfold
| "*"
)
: ?tenfoldroman
)
& !tenfoldroman:?roman
& ( !cifr:9&!roman I X:?roman
|   !cifr:~<4
&     !roman
(!cifr:4&I|)
V
: ?roman
& !cifr+-5:?cifr
& ~
|   whl
' ( !cifr+-1:~<0:?cifr
& !roman I:?roman
)
)
)
& ( !roman:? "*" ?&~
| str$!roman ) ) & 1990 2008 1666 3888 3999 4000:?NS & whl ' ( !NS:%?N ?NS & out$ ( encode$!N:?K&!N !K | str$("Can't convert " !N " to Roman numeral")
)
)
);
Output:
1990 MCMXC
2008 MMVIII
1666 MDCLXVI
3888 MMMDCCCLXXXVIII
3999 MMMCMXCIX
Can't convert 4000 to Roman numeral

## C

### Naive solution

This solution is a smart but does not return the number written as a string.

#include <stdio.h>

int main() {
int arabic[] = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1};

// There is a bug: "XL\0" is translated into sequence 58 4C 00 00, i.e. it is 4-bytes long...
// Should be "XL" without \0 etc.
//
char roman[13][3] = {"M\0", "CM\0", "D\0", "CD\0", "C\0", "XC\0", "L\0", "XL\0", "X\0", "IX\0", "V\0", "IV\0", "I\0"};
int N;

printf("Enter arabic number:\n");
scanf("%d", &N);
printf("\nRoman number:\n");

for (int i = 0; i < 13; i++) {
while (N >= arabic[i]) {
printf("%s", roman[i]);
N -= arabic[i];
}
}
return 0;
}

Output:
Enter arabic number:
215

Roman number:
CCXV


#define _CRT_SECURE_NO_WARNINGS

#include <stdio.h>
#include <string.h>

int RomanNumerals_parseInt(const char* string)
{
int value;
return scanf("%u", &value) == 1 && value > 0 ? value : 0;
}

const char* RomanNumerals_toString(int value)
{
#define ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE 64
static buffer[ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE];

const static int maxValue = 5000;
const static int minValue = 1;

const static struct Digit {
char string[4]; // It's better to use 4 than 3 (aligment).
int  value;
} digits[] = {
{"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 },
{"?", 0}
};

*buffer = '\0'; // faster than memset(buffer, 0, sizeof(buffer));
if (minValue <= value && value <= maxValue)
{
struct Digit* digit = &digits[0];

while (digit->value)
{
while (value >= digit->value)
{
value -= digit->value;
// It is not necessary - total length would not be exceeded...
// if (strlen(buffer) + strlen(digit->string) < sizeof(buffer))
strcat(buffer, digit->string);
}
digit++;
}
}
return buffer;
}

int main(int argc, char* argv[])
{
if (argc < 2)
{
// Blanks are needed for a consistient blackground on some systems.
// BTW, puts append an extra newline at the end.
//
puts("Write given numbers as Roman numerals. \n"
"                                       \n"
"Usage:                                 \n"
"    roman n1 n2 n3 ...                 \n"
"                                       \n"
"where n1 n2 n3 etc. are Arabic numerals\n");

int numbers[] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1498, 2022 };
for (int i = 0; i < sizeof(numbers) / sizeof(int); i++)
{
printf("%4d = %s\n",
numbers[i], RomanNumerals_toString(numbers[i]));
}
}
else
{
for (int i = 1; i < argc; i++)
{
int number = RomanNumerals_parseInt(argv[i]);
if (number)
{
puts(RomanNumerals_toString(number));
}
else
{
puts("???");
}
}
}

return 0;
}

Output:
Write given numbers as Roman numerals.

Usage:
roman n1 n2 n3 ...

where n1 n2 n3 etc. are Arabic numerals

1 = I
2 = II
3 = III
4 = IV
5 = V
6 = VI
7 = VII
8 = VIII
9 = IX
10 = X
1498 = MCDXCVIII
2022 = MMXXII

## C#

using System;
class Program
{
static uint[] nums = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 };
static string[] rum = { "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" };

static string ToRoman(uint number)
{
string value = "";
for (int i = 0; i < nums.Length && number != 0; i++)
{
while (number >= nums[i])
{
number -= nums[i];
value += rum[i];
}
}
return value;
}

static void Main()
{
for (uint number = 1; number <= 1 << 10; number *= 2)
{
Console.WriteLine("{0} = {1}", number, ToRoman(number));
}
}
}


One-liner Mono REPL

Func<int, string> toRoman = (number) =>
new Dictionary<int, string>
{
{1000, "M"},
{900, "CM"},
{500, "D"},
{400, "CD"},
{100, "C"},
{90, "XC"},
{50, "L"},
{40, "XL"},
{10, "X"},
{9, "IX"},
{5, "V"},
{4, "IV"},
{1, "I"}
}.Aggregate(new string('I', number), (m, _) => m.Replace(new string('I', _.Key), _.Value));

Output:
1 = I
2 = II
4 = IV
8 = VIII
16 = XVI
32 = XXXII
64 = LXIV
128 = CXXVIII
256 = CCLVI
512 = DXII
1024 = MXXIV


## C++

### C++ 98

#include <iostream>
#include <string>

std::string to_roman(int value)
{
struct romandata_t { int value; char const* numeral; };
static romandata_t const romandata[] =
{ 1000, "M",
900, "CM",
500, "D",
400, "CD",
100, "C",
90, "XC",
50, "L",
40, "XL",
10, "X",
9, "IX",
5, "V",
4, "IV",
1, "I",
0, NULL }; // end marker

std::string result;
for (romandata_t const* current = romandata; current->value > 0; ++current)
{
while (value >= current->value)
{
result += current->numeral;
value  -= current->value;
}
}
return result;
}

int main()
{
for (int i = 1; i <= 4000; ++i)
{
std::cout << to_roman(i) << std::endl;
}
}


### C++ 11

#include <iostream>
#include <string>

std::string to_roman(int x) {
if (x <= 0)
return "Negative or zero!";
auto roman_digit = [](char one, char five, char ten, int x) {
if (x <= 3)
return std::string().assign(x, one);
if (x <= 5)
return std::string().assign(5 - x, one) + five;
if (x <= 8)
return five + std::string().assign(x - 5, one);
return std::string().assign(10 - x, one) + ten;
};
if (x >= 1000)
return x - 1000 > 0 ? "M" + to_roman(x - 1000) : "M";
if (x >= 100) {
auto s = roman_digit('C', 'D', 'M', x / 100);
return x % 100 > 0 ? s + to_roman(x % 100) : s;
}
if (x >= 10) {
auto s = roman_digit('X', 'L', 'C', x / 10);
return x % 10 > 0 ? s + to_roman(x % 10) : s;
}
return roman_digit('I', 'V', 'X', x);
}

int main() {
for (int i = 0; i < 2018; i++)
std::cout << i << " --> " << to_roman(i) << std::endl;
}


## Ceylon

shared void run() {

class Numeral(shared Character char, shared Integer int) {}

value tiers = [
[Numeral('I', 1),   Numeral('V', 5),   Numeral('X', 10)],
[Numeral('X', 10),  Numeral('L', 50),  Numeral('C', 100)],
[Numeral('C', 100), Numeral('D', 500), Numeral('M', 1k)]
];

String toRoman(Integer hindu, Integer tierIndex = 2) {

assert (exists tier = tiers[tierIndex]);

" Finds if it's a two character numeral like iv, ix, xl, xc, cd and cm."
function findTwoCharacterNumeral() =>
if (exists bigNum = tier.rest.find((numeral) => numeral.int - tier.first.int <= hindu < numeral.int))
then [tier.first, bigNum]
else null;

if (hindu <= 0) {
// if it's zero then we are done!
return "";
}
else if (exists [smallNum, bigNum] = findTwoCharacterNumeral()) {
value twoCharSymbol = "smallNum.charbigNum.char";
value twoCharValue = bigNum.int - smallNum.int;
return "twoCharSymboltoRoman(hindu - twoCharValue, tierIndex)";
}
else if (exists num = tier.reversed.find((Numeral elem) => hindu >= elem.int)) {
return "num.chartoRoman(hindu - num.int, tierIndex)";
}
else {
// nothing was found so move to the next smaller tier!
}
}

assert (toRoman(1) == "I");
assert (toRoman(2) == "II");
assert (toRoman(4) == "IV");
assert (toRoman(1666) == "MDCLXVI");
assert (toRoman(1990) == "MCMXC");
assert (toRoman(2008) == "MMVIII");
}


## Clojure

The easiest way is to use the built-in cl-format function

(def arabic->roman
(partial clojure.pprint/cl-format nil "~@R"))

(arabic->roman 147)
;"CXXIII"
(arabic->roman 99)
;"XCIX"

Alternatively:
(def roman-map
(sorted-map
1    "I", 4    "IV", 5   "V", 9   "IX",
10   "X", 40   "XL", 50  "L", 90  "XC",
100  "C", 400  "CD", 500 "D", 900 "CM"
1000 "M"))

(defn int->roman [n]
{:pre (integer? n)}
(loop [res (StringBuilder.), n n]
(if-let [v (roman-map n)]
(str (.append res v))
(let [[k v] (->> roman-map keys (filter #(> n %)) last (find roman-map))]
(recur (.append res v) (- n k))))))

(int->roman 1999)
; "MCMXCIX"


An alternate implementation:

(defn a2r [a]
(let [rv '(1000 500 100 50 10 5 1)
rm (zipmap rv "MDCLXVI")
dv (->> rv (take-nth 2) next #(interleave % %))]
(loop [a a rv rv dv dv r nil]
(if (<= a 0)
r
(let [v (first rv)
d (or (first dv) 0)
l (- v d)]
(cond
(= a v) (str r (rm v))
(= a l) (str r (rm d) (rm v))
(and (> a v) (> a l)) (recur (- a v) rv dv (str r (rm v)))
(and (< a v) (< a l)) (recur a (rest rv) (rest dv) r)
:else (recur (- a l) (rest rv) (rest dv) (str r (rm d) (rm v)))))))))


Usage:

(a2r 1666)
"MDCLXVI"

(map a2r [1000 1 389 45])
("M" "I" "CCCLXXXIX" "XLV")


An alternate implementation:

(def roman-map
(sorted-map-by >
1    "I", 4    "IV", 5   "V", 9   "IX",
10   "X", 40   "XL", 50  "L", 90  "XC",
100  "C", 400  "CD", 500 "D", 900 "CM"
1000 "M"))

(defn a2r
([r]
(reduce str (a2r r (keys roman-map))))
([r n]
(when-not (empty? n)
(let [e (first n)
v (- r e)
roman (roman-map e)]
(cond
(< v 0) (a2r r (rest n))
(= v 0) (cons roman [])
(>= v e) (cons roman (a2r v n))
(< v e) (cons roman (a2r v (rest n))))))))


Usage:

(a2r 1666)
"MDCLXVI"

(map a2r [1000 1 389 45])
("M" "I" "CCCLXXXIX" "XLV")


## CLU

roman = cluster is encode
rep = null

dmap = struct[v: int, s: string]
darr = array[dmap]
own chunks: darr := darr$[dmap${v: 1000, s: "M"},
dmap${v: 900, s: "CM"}, dmap${v:  500, s: "D"},
dmap${v: 400, s: "CD"}, dmap${v:  100, s: "C"},
dmap${v: 90, s: "XC"}, dmap${v:   50, s: "L"},
dmap${v: 40, s: "XL"}, dmap${v:   10, s: "X"},
dmap${v: 9, s: "IX"}, dmap${v:    5, s: "V"},
dmap${v: 4, s: "IV"}, dmap${v:    1, s: "I"}]

largest_chunk = proc (i: int) returns (int, string)
for chunk: dmap in darr$elements(chunks) do if chunk.v <= i then return (chunk.v, chunk.s) end end return (0, "") end largest_chunk encode = proc (i: int) returns (string) result: string := "" while i > 0 do val: int chunk: string val, chunk := largest_chunk(i) result := result || chunk i := i - val end return (result) end encode end roman start_up = proc () po: stream := stream$primary_output()
tests: array[int] := array[int]$[1666, 2008, 1001, 1999, 3888, 2021] for test: int in array[int]$elements(tests) do
MCMXC
MMVIII
MDCLXVI

## D

string toRoman(int n) pure nothrow
in {
assert(n < 5000);
} body {
static immutable weights = [1000, 900, 500, 400, 100, 90,
50, 40, 10, 9, 5, 4, 1];
static immutable symbols = ["M","CM","D","CD","C","XC","L",
"XL","X","IX","V","IV","I"];

string roman;
foreach (i, w; weights) {
while (n >= w) {
roman ~= symbols[i];
n -= w;
}
if (n == 0)
break;
}
return roman;
} unittest {
assert(toRoman(455)  == "CDLV");
assert(toRoman(3456) == "MMMCDLVI");
assert(toRoman(2488) == "MMCDLXXXVIII");
}

void main() {}


## Delphi

Translation of: DWScript
program RomanNumeralsEncode;

{$APPTYPE CONSOLE} function IntegerToRoman(aValue: Integer): string; var i: Integer; const WEIGHTS: array[0..12] of Integer = (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1); SYMBOLS: array[0..12] of string = ('M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'); begin for i := Low(WEIGHTS) to High(WEIGHTS) do begin while aValue >= WEIGHTS[i] do begin Result := Result + SYMBOLS[i]; aValue := aValue - WEIGHTS[i]; end; if aValue = 0 then Break; end; end; begin Writeln(IntegerToRoman(1990)); // MCMXC Writeln(IntegerToRoman(2008)); // MMVIII Writeln(IntegerToRoman(1666)); // MDCLXVI end.  ## DWScript Translation of: D const weights = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]; const symbols = ["M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"]; function toRoman(n : Integer) : String; var i, w : Integer; begin for i := 0 to weights.High do begin w := weights[i]; while n >= w do begin Result += symbols[i]; n -= w; end; if n = 0 then Break; end; end; PrintLn(toRoman(455)); PrintLn(toRoman(3456)); PrintLn(toRoman(2488));  ## EasyLang values[] = [ 1000 900 500 400 100 90 50 40 10 9 5 4 1 ] symbol$[] = [ "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I" ]
func num2rom num . rom$. rom$ = ""
for i range len values[]
while num >= values[i]
rom$&= symbol$[i]
num -= values[i]
.
.
.
call num2rom 1990 r$print r$
call num2rom 2008 r$print r$
call num2rom 1666 r$print r$


## ECL

RomanEncode(UNSIGNED Int) := FUNCTION
SetWeights := [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
SetSymbols := ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'];
ProcessRec := RECORD
UNSIGNED val;
STRING Roman;
END;
dsWeights  := DATASET(13,TRANSFORM(ProcessRec,SELF.val := Int, SELF := []));

SymbolStr(i,n,STRING s) := CHOOSE(n+1,'',SetSymbols[i],SetSymbols[i]+SetSymbols[i],SetSymbols[i]+SetSymbols[i]+SetSymbols[i],s);

RECORDOF(dsWeights) XF(dsWeights L, dsWeights R, INTEGER C) := TRANSFORM
ThisVal := IF(C=1,R.Val,L.Val);
IsDone := ThisVal = 0;
SELF.Roman := IF(IsDone,L.Roman,L.Roman + SymbolStr(C,ThisVal DIV SetWeights[C],L.Roman));
SELF.val := IF(IsDone,0,ThisVal - ((ThisVal DIV SetWeights[C])*SetWeights[C]));
END;
i := ITERATE(dsWeights,XF(LEFT,RIGHT,COUNTER));
RETURN i[13].Roman;
END;

RomanEncode(1954);  //MCMLIV
RomanEncode(1990 ); //MCMXC
RomanEncode(2008 ); //MMVIII
RomanEncode(1666);  //MDCLXVI


## Eiffel

class
APPLICATION

create
make

feature {NONE} -- Initialization

make
local
numbers: ARRAY [INTEGER]
do
numbers := <<1990, 2008, 1666, 3159, 1977, 2010>>
-- "MCMXC", "MMVIII", "MDCLXVI", "MMMCLIX", "MCMLXXVII", "MMX"
across numbers as n loop
print (n.item.out + " in decimal Arabic numerals is " +
decimal_to_roman (n.item) + " in Roman numerals.%N")
end
end

feature -- Roman numerals

decimal_to_roman (a_int: INTEGER): STRING
-- Representation of integer a_int' as Roman numeral
require
a_int > 0
local
dnums: ARRAY[INTEGER]
rnums: ARRAY[STRING]

dnum: INTEGER
rnum: STRING

i: INTEGER
do
dnums := <<1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1>>
rnums := <<"M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I">>

dnum := a_int
rnum := ""

from
i := 1
until
i > dnums.count or dnum <= 0
loop
from
until
dnum < dnums[i]
loop
dnum := dnum - dnums[i]
rnum := rnum + rnums[i]
end
i := i + 1
end

Result := rnum
end
end


## Ela

open number string math

digit x y z k =
[[x],[x,x],[x,x,x],[x,y],[y],[y,x],[y,x,x],[y,x,x,x],[x,z]] :
(toInt k - 1)

toRoman 0 = ""
toRoman x | x < 0     = fail "Negative roman numeral"
| x >= 1000 = 'M' :: toRoman (x - 1000)
| x >= 100  = let (q,r) = x divrem 100 in
digit 'C' 'D' 'M' q ++ toRoman r
| x >= 10   = let (q,r) = x divrem 10 in
digit 'X' 'L' 'C' q ++ toRoman r
| else = digit 'I' 'V' 'X' x

map (join "" << toRoman) [1999,25,944]
Output:
["MCMXCIX","XXV","CMXLIV"]

## Elena

Translation of: C#

ELENA 5.0 :

import system'collections;
import system'routines;
import extensions;
import extensions'text;

static RomanDictionary = Dictionary.new()
.setAt(1000, "M")
.setAt(900, "CM")
.setAt(500, "D")
.setAt(400, "CD")
.setAt(100, "C")
.setAt(90, "XC")
.setAt(50, "L")
.setAt(40, "XL")
.setAt(10, "X")
.setAt(9, "IX")
.setAt(5, "V")
.setAt(4, "IV")
.setAt(1, "I");

extension op
{
toRoman()
= RomanDictionary.accumulate(new StringWriter("I", self), (m,kv => m.replace(new StringWriter("I",kv.Key), kv.Value)));
}

public program()
{
console.printLine("1990 : ", 1990.toRoman());
console.printLine("2008 : ", 2008.toRoman());
console.printLine("1666 : ", 1666.toRoman())
}
Output:
1990 : MCMXC
2008 : MMVIII
1666 : MDCLXVI


## Elixir

Translation of: Erlang
defmodule Roman_numeral do
def encode(0), do: ''
def encode(x) when x >= 1000, do: [?M | encode(x - 1000)]
def encode(x) when x >= 100,  do: digit(div(x,100), ?C, ?D, ?M) ++ encode(rem(x,100))
def encode(x) when x >= 10,   do: digit(div(x,10), ?X, ?L, ?C) ++ encode(rem(x,10))
def encode(x) when x >= 1,    do: digit(x, ?I, ?V, ?X)

defp digit(1, x, _, _), do: [x]
defp digit(2, x, _, _), do: [x, x]
defp digit(3, x, _, _), do: [x, x, x]
defp digit(4, x, y, _), do: [x, y]
defp digit(5, _, y, _), do: [y]
defp digit(6, x, y, _), do: [y, x]
defp digit(7, x, y, _), do: [y, x, x]
defp digit(8, x, y, _), do: [y, x, x, x]
defp digit(9, x, _, z), do: [x, z]
end


Another:

Translation of: Ruby
defmodule Roman_numeral do
@symbols [ {1000, 'M'}, {900, 'CM'}, {500, 'D'}, {400, 'CD'}, {100, 'C'}, {90, 'XC'},
{50, 'L'}, {40, 'XL'}, {10, 'X'}, {9, 'IX'}, {5, 'V'}, {4, 'IV'}, {1, 'I'} ]
def encode(num) do
{roman,_} = Enum.reduce(@symbols, {[], num}, fn {divisor, letter}, {memo, n} ->
{memo ++ List.duplicate(letter, div(n, divisor)), rem(n, divisor)}
end)
Enum.join(roman)
end
end


Test:

Enum.each([1990, 2008, 1666], fn n ->
IO.puts "#{n}: #{Roman_numeral.encode(n)}"
end)

Output:
1990: MCMXC
2008: MMVIII
1666: MDCLXVI


## Emacs Lisp

(defun ar2ro (AN)
"Translate from arabic number AN to roman number.
For example, (ar2ro 1666) returns (M D C L X V I)."
(cond
((>= AN 1000) (cons 'M (ar2ro (- AN 1000))))
((>= AN 900) (cons 'C (cons 'M (ar2ro (- AN 900)))))
((>= AN 500) (cons 'D (ar2ro (- AN 500))))
((>= AN 400) (cons 'C (cons 'D (ar2ro (- AN 400)))))
((>= AN 100) (cons 'C (ar2ro (- AN 100))))
((>= AN 90) (cons 'X (cons 'C (ar2ro (- AN 90)))))
((>= AN 50) (cons 'L (ar2ro (- AN 50))))
((>= AN 40) (cons 'X (cons 'L (ar2ro (- AN 40)))))
((>= AN 10) (cons 'X (ar2ro (- AN 10))))
((>= AN 5) (cons 'V (ar2ro (- AN 5))))
((>= AN 4) (cons 'I (cons 'V (ar2ro (- AN 4)))))
((>= AN 1) (cons 'I (ar2ro (- AN 1))))
((= AN 0) nil)))


## Erlang

Translation of: OCaml
-module(roman).
-export([to_roman/1]).

to_roman(0) -> [];
to_roman(X) when X >= 1000 -> [$M | to_roman(X - 1000)]; to_roman(X) when X >= 100 -> digit(X div 100,$C, $D,$M) ++ to_roman(X rem 100);
to_roman(X) when X >= 10 ->
digit(X div 10, $X,$L, $C) ++ to_roman(X rem 10); to_roman(X) when X >= 1 -> digit(X,$I, $V,$X).

digit(1, X, _, _) -> [X];
digit(2, X, _, _) -> [X, X];
digit(3, X, _, _) -> [X, X, X];
digit(4, X, Y, _) -> [X, Y];
digit(5, _, Y, _) -> [Y];
digit(6, X, Y, _) -> [Y, X];
digit(7, X, Y, _) -> [Y, X, X];
digit(8, X, Y, _) -> [Y, X, X, X];
digit(9, X, _, Z) -> [X, Z].


sample:

1> c(roman).
{ok,roman}
2> roman:to_roman(1999).
"MCMXCIX"
3> roman:to_roman(25).
"XXV"
4> roman:to_roman(944).
"CMXLIV"


Alternative:

-module( roman_numerals ).

-export( [encode_from_integer/1]).

-record( encode_acc, {n, romans=""} ).

encode_from_integer( N ) when N > 0 ->
#encode_acc{romans=Romans} = lists:foldl( fun encode_from_integer/2, #encode_acc{n=N}, map() ),
Romans.

encode_from_integer( _Map, #encode_acc{n=0}=Acc ) -> Acc;
encode_from_integer( {_Roman, Value}, #encode_acc{n=N}=Acc ) when N < Value -> Acc;
encode_from_integer( {Roman, Value}, #encode_acc{n=N, romans=Romans} ) ->
Times = N div Value,
New_roman = lists:flatten( lists:duplicate(Times, Roman) ),
#encode_acc{n=N - (Times * Value), romans=Romans ++ New_roman}.

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}].

Output:
36> roman_numerals:encode_from_integer( 1990 ).
"MCMXC"
37> roman_numerals:encode_from_integer( 2008 ).
"MMVIII"
38> roman_numerals:encode_from_integer( 1666 ).
"MDCLXVI"


## ERRE

PROGRAM ARAB2ROMAN

DIM ARABIC%[12],ROMAN$[12] PROCEDURE TOROMAN(VALUE->ANS$)
LOCAL RESULT$FOR I%=0 TO 12 DO WHILE VALUE>=ARABIC%[I%] DO RESULT$+=ROMAN$[I%] VALUE-=ARABIC%[I%] END WHILE END FOR ANS$=RESULT$END PROCEDURE BEGIN ! !Testing ! ARABIC%[]=(1000,900,500,400,100,90,50,40,10,9,5,4,1) ROMAN$[]=("M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I")
TOROMAN(2009->ANS$) PRINT("2009 = ";ANS$)
TOROMAN(1666->ANS$) PRINT("1666 = ";ANS$)
TOROMAN(3888->ANS$) PRINT("3888 = ";ANS$)
END PROGRAM

## Euphoria

Translation of: BASIC
constant arabic = {1000, 900, 500, 400, 100, 90, 50,  40,  10,  9,  5,   4,  1 }
constant roman  = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}

function toRoman(integer val)
sequence result
result = ""
for i = 1 to 13 do
while val >= arabic[i] do
result &= roman[i]
val -= arabic[i]
end while
end for
return result
end function

printf(1,"%d = %s\n",{2009,toRoman(2009)})
printf(1,"%d = %s\n",{1666,toRoman(1666)})
printf(1,"%d = %s\n",{3888,toRoman(3888)})
Output:
 2009 = MMIX
1666 = MDCLXVI
3888 = MMMDCCCLXXXVIII


## Excel

Excel can encode numbers in Roman forms in 5 successively concise forms. These can be indicated from 0 to 4. Type in a cell:

=ROMAN(2013,0)

It becomes:

MMXIII


## F#

let digit x y z = function
1 -> x
| 2 -> x + x
| 3 -> x + x + x
| 4 -> x + y
| 5 -> y
| 6 -> y + x
| 7 -> y + x + x
| 8 -> y + x + x + x
| 9 -> x + z
| _ -> failwith "invalid call to digit"

let rec to_roman acc = function
| x when x >= 1000 -> to_roman (acc + "M") (x - 1000)
| x when x >= 100 -> to_roman (acc + digit "C" "D" "M" (x / 100)) (x % 100)
| x when x >= 10 -> to_roman (acc + digit "X" "L" "C" (x / 10)) (x % 10)
| x when x > 0 -> acc + digit "I" "V" "X" x
| 0 -> acc
| _ -> failwith "invalid call to_roman (negative input)"

let roman n = to_roman "" n

[<EntryPoint>]
let main args =
[1990; 2008; 1666]
|> List.map (fun n -> roman n)
|> List.iter (printfn "%s")
0

Output:
MCMXC
MMVIII
MDCLXVI

## Factor

A roman numeral library ships with Factor.

USE: roman
( scratchpad ) 3333 >roman .
"mmmcccxxxiii"


Parts of the implementation:

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 }

ERROR: roman-range-error n ;

: roman-range-check ( n -- n )
dup 1 10000 between? [ roman-range-error ] unless ;

: >roman ( n -- str )
roman-range-check
roman-values roman-digits [
[ /mod swap ] dip <repetition> concat
] 2map "" concat-as nip ;


## FALSE

^$." " [$999>][1000- "M"]#
$899> [ 900-"CM"]?$499> [ 500- "D"]?
$399> [ 400-"CD"]? [$ 99>][ 100- "C"]#
$89> [ 90-"XC"]?$ 49> [  50- "L"]?
$39> [ 40-"XL"]? [$  9>][  10- "X"]#
$8> [ 9-"IX"]?$  4> [   5- "V"]?
$3> [ 4-"IV"]? [$    ][   1- "I"]#%

## Fan

**
** converts a number to its roman numeral representation
**
class RomanNumerals
{

private Str digit(Str x, Str y, Str z, Int i)
{
switch (i)
{
case 1: return x
case 2: return x+x
case 3: return x+x+x
case 4: return x+y
case 5: return y
case 6: return y+x
case 7: return y+x+x
case 8: return y+x+x+x
case 9: return x+z
}
return ""
}

Str toRoman(Int i)
{
if (i>=1000) { return "M" + toRoman(i-1000) }
if (i>=100) { return digit("C", "D", "M", i/100) + toRoman(i%100) }
if (i>=10) { return digit("X", "L", "C", i/10) + toRoman(i%10) }
if (i>=1) { return digit("I", "V", "X", i) }
return ""
}

Void main()
{
2000.times |i| { echo("$i =${toRoman(i)}") }
}

}


## Forth

: vector create ( n -- ) 0 do , loop  does>  ( n -- ) swap cells + @ execute ;
\ these are ( numerals -- numerals )
: ,I  dup c@ C, ;  : ,V  dup 1 + c@ C, ;  : ,X  dup 2 + c@ C, ;

\ these are ( numerals -- )
:noname  ,I ,X     drop ;   :noname  ,V ,I ,I ,I  drop ;   :noname  ,V ,I ,I  drop ;
:noname  ,V ,I     drop ;   :noname  ,V           drop ;   :noname  ,I ,V     drop ;
:noname  ,I ,I ,I  drop ;   :noname  ,I ,I        drop ;   :noname  ,I        drop ;
' drop ( 0 : no output )  10 vector ,digit

: roman-rec ( numerals n -- )  10 /mod dup if >r over 2 + r> recurse else drop then ,digit ;
: roman ( n -- c-addr u )
dup 0 4000 within 0= abort" EX LIMITO!"
HERE SWAP  s" IVXLCDM" drop swap roman-rec  HERE OVER - ;

1999 roman type     \ MCMXCIX
25 roman type     \ XXV
944 roman type     \ CMXLIV


Alternative implementation

create romans 0 , 1 , 5 , 21 , 9 , 2 , 6 , 22 , 86 , 13 ,
does> swap cells + @ ;

: roman-digit                          ( a1 n1 a2 n2 -- a3)
drop >r romans
begin dup while tuck 4 mod 1- chars r@ + c@ over c! char+ swap 4 / repeat
r> drop drop
;

: (split) swap >r /mod r> swap ;

: >roman                               ( n1 a -- a n2)
tuck 1000 (split) s" M  " roman-digit 100 (split) s" CDM" roman-digit
10 (split) s" XLC" roman-digit 1 (split) s" IVX" roman-digit nip over -
;

create (roman) 16 chars allot

1999 (roman) >roman type cr


## Fortran

Works with: Fortran version 90 and later
program roman_numerals

implicit none

write (*, '(a)') roman (2009)
write (*, '(a)') roman (1666)
write (*, '(a)') roman (3888)

contains

function roman (n) result (r)

implicit none
integer, intent (in) :: n
integer, parameter   :: d_max = 13
integer              :: d
integer              :: m
integer              :: m_div
character (32)       :: r
integer,        dimension (d_max), parameter :: d_dec = &
& (/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/)
character (32), dimension (d_max), parameter :: d_rom = &
& (/'M ', 'CM', 'D ', 'CD', 'C ', 'XC', 'L ', 'XL', 'X ', 'IX', 'V ', 'IV', 'I '/)

r = ''
m = n
do d = 1, d_max
m_div = m / d_dec (d)
r = trim (r) // repeat (trim (d_rom (d)), m_div)
m = m - d_dec (d) * m_div
end do

end function roman

end program roman_numerals

Output:
  MMIX
MDCLXVI
MMMDCCCLXXXVIII


## Go

For fluff, the unicode overbar is recognized as a factor of 1000, as described in WP.

If you see boxes in the code below, those are supposed to be the Unicode combining overline (U+0305) and look like IVXLCDM. Or, if you see overstruck combinations of letters, that's a different font rendering problem. (If you need roman numerals > 3999 reliably, it might best to stick to chiseling them in stone...)

package main

import "fmt"

var (
m0 = []string{"", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX"}
m1 = []string{"", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC"}
m2 = []string{"", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM"}
m3 = []string{"", "M", "MM", "MMM", "I̅V̅",
"V̅", "V̅I̅", "V̅I̅I̅", "V̅I̅I̅I̅", "I̅X̅"}
m4 = []string{"", "X̅", "X̅X̅", "X̅X̅X̅", "X̅L̅",
"L̅", "L̅X̅", "L̅X̅X̅", "L̅X̅X̅X̅", "X̅C̅"}
m5 = []string{"", "C̅", "C̅C̅", "C̅C̅C̅", "C̅D̅",
"D̅", "D̅C̅", "D̅C̅C̅", "D̅C̅C̅C̅", "C̅M̅"}
m6 = []string{"", "M̅", "M̅M̅", "M̅M̅M̅"}
)

func formatRoman(n int) (string, bool) {
if n < 1 || n >= 4e6 {
return "", false
}
// this is efficient in Go.  the seven operands are evaluated,
// then a single allocation is made of the exact size needed for the result.
return m6[n/1e6] + m5[n%1e6/1e5] + m4[n%1e5/1e4] + m3[n%1e4/1e3] +
m2[n%1e3/1e2] + m1[n%100/10] + m0[n%10],
true
}

func main() {
// show three numbers mentioned in task descriptions
for _, n := range []int{1990, 2008, 1666} {
r, ok := formatRoman(n)
if ok {
fmt.Println(n, "==", r)
} else {
fmt.Println(n, "not representable")
}
}
}

Output:
1990 == MCMXC
2008 == MMVIII
1666 == MDCLXVI


## Golo

#!/usr/bin/env golosh
----
This module takes a decimal integer and converts it to a Roman numeral.
----
module Romannumeralsencode

augment java.lang.Integer {

function digits = |this| {

var remaining = this
let digits = vector[]
while remaining > 0 {
digits: prepend(remaining % 10)
remaining = remaining / 10
}
return digits
}

----
123: digitsWithPowers() will return [[1, 2], [2, 1], [3, 0]]
----
function digitsWithPowers = |this| -> vector[
[ this: digits(): get(i), (this: digits(): size() - 1) - i ] for (var i = 0, i < this: digits(): size(), i = i + 1)
]

function encode = |this| {

require(this > 0, "the integer must be positive!")

let romanPattern = |digit, powerOf10| -> match {
when digit == 1 then i
when digit == 2 then i + i
when digit == 3 then i + i + i
when digit == 4 then i + v
when digit == 5 then v
when digit == 6 then v + i
when digit == 7 then v + i + i
when digit == 8 then v + i + i + i
when digit == 9 then i + x
otherwise ""
} with {
i, v, x = [
[ "I", "V", "X" ],
[ "X", "L", "C" ],
[ "C", "D", "M" ],
[ "M", "?", "?" ]
]: get(powerOf10)
}

return vector[ romanPattern(digit, power) foreach digit, power in this: digitsWithPowers() ]: join("")
}
}

function main = |args| {
println("1990 == MCMXC? " + (1990: encode() == "MCMXC"))
println("2008 == MMVIII? " + (2008: encode() == "MMVIII"))
println("1666 == MDCLXVI? " + (1666: encode() == "MDCLXVI"))
}


## Groovy

symbols = [ 1:'I', 4:'IV', 5:'V', 9:'IX', 10:'X', 40:'XL', 50:'L', 90:'XC', 100:'C', 400:'CD', 500:'D', 900:'CM', 1000:'M' ]

def roman(arabic) {
def result = ""
symbols.keySet().sort().reverse().each {
while (arabic >= it) {
arabic-=it
result+=symbols[it]
}
}
return result
}
assert roman(1) == 'I'
assert roman(2) == 'II'
assert roman(4) == 'IV'
assert roman(8) == 'VIII'
assert roman(16) == 'XVI'
assert roman(32) == 'XXXII'
assert roman(25) == 'XXV'
assert roman(64) == 'LXIV'
assert roman(128) == 'CXXVIII'
assert roman(256) == 'CCLVI'
assert roman(512) == 'DXII'
assert roman(954) == 'CMLIV'
assert roman(1024) == 'MXXIV'
assert roman(1666) == 'MDCLXVI'
assert roman(1990) == 'MCMXC'
assert roman(2008) == 'MMVIII'


With an explicit decimal digit representation list:

digit :: Char -> Char -> Char -> Integer -> String
digit x y z k =
[[x], [x, x], [x, x, x], [x, y], [y], [y, x], [y, x, x], [y, x, x, x], [x, z]] !!
(fromInteger k - 1)

toRoman :: Integer -> String
toRoman 0 = ""
toRoman x
| x < 0 = error "Negative roman numeral"
toRoman x
| x >= 1000 = 'M' : toRoman (x - 1000)
toRoman x
| x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r
where
(q, r) = x divMod 100
toRoman x
| x >= 10 = digit 'X' 'L' 'C' q ++ toRoman r
where
(q, r) = x divMod 10
toRoman x = digit 'I' 'V' 'X' x

main :: IO ()
main = print $toRoman <$> [1999, 25, 944]

Output:
["MCMXCIX","XXV","CMXLIV"]

or, defining romanFromInt in terms of mapAccumL

import Data.Bifunctor (first)
import Data.List (mapAccumL)
import Data.Tuple (swap)

roman :: Int -> String
roman =
romanFromInt $zip [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1] (words "M CM D CD C XC L XL X IX V IV I") romanFromInt :: [(Int, String)] -> Int -> String romanFromInt nks n = concat . snd$ mapAccumL go n nks
where
go a (v, s) = swap $first ((>> s) . enumFromTo 1)$ quotRem a v

main :: IO ()
ONE SIX SIX SIX

MDCLXVI



## Io

Translation of: C#
Roman := Object clone do (
nums := list(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)
rum := list("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")

numeral := method(number,
result := ""
for(i, 0, nums size,
if(number == 0, break)
while(number >= nums at(i),
number = number - nums at(i)
result = result .. rum at(i)
)
)
return result
)
)

Roman numeral(1666) println


## J

rfd obtains Roman numerals from decimals.

R1000=. ;L:1 ,{ <@(<;._1);._2]0 :0
C CC CCC CD D DC DCC DCCC CM
X XX XXX XL L LX LXX LXXX XC
I II III IV V VI VII VIII IX
)

rfd=: ('M' $~ <.@%&1000) , R1000 {::~ 1000&|  Explanation: R1000's definition contains rows representing each of 10 different digits in the 100s, 10s and 1s column (the first entry in each row is blank -- each entry is preceded by a space). R1000 itself represents the first 1000 roman numerals (the cartesian product of these three rows of roman numeral "digits" which is constructed so that they are in numeric order. And the first entry -- zero -- is just blank). To convert a number to its roman numeral representation, we will separate the number into the integer part after dividing by 1000 (that's the number of 'M's we need) and the remainder after dividing by 1000 (which will be an index into R1000). For example:  rfd 1234 MCCXXXIV rfd 567 DLXVII rfd 89 LXXXIX  Derived from the J Wiki. Further examples of use will be found there. ## Java Translation of: Ada The conversion function throws an IllegalArgumentException for non-positive numbers, since Java does not have unsigned primitives. Works with: Java version 1.5+ public class RN { enum Numeral { 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); int weight; Numeral(int weight) { this.weight = weight; } }; public static String roman(long n) { if( n <= 0) { throw new IllegalArgumentException(); } StringBuilder buf = new StringBuilder(); final Numeral[] values = Numeral.values(); for (int i = values.length - 1; i >= 0; i--) { while (n >= values[i].weight) { buf.append(values[i]); n -= values[i].weight; } } return buf.toString(); } public static void test(long n) { System.out.println(n + " = " + roman(n)); } public static void main(String[] args) { test(1999); test(25); test(944); test(0); } }  Output: 1999 = MCMXCIX 25 = XXV 944 = CMXLIV Exception in thread "main" java.lang.IllegalArgumentException at RN.roman(RN.java:15) at RN.test(RN.java:31) at RN.main(RN.java:38) Works with: Java version 1.8+ import java.util.Set; import java.util.EnumSet; import java.util.Collections; import java.util.stream.Collectors; import java.util.stream.LongStream; public interface RomanNumerals { public enum Numeral { 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); public final long weight; private static final Set<Numeral> SET = Collections.unmodifiableSet(EnumSet.allOf(Numeral.class)); private Numeral(long weight) { this.weight = weight; } public static Numeral getLargest(long weight) { return SET.stream() .filter(numeral -> weight >= numeral.weight) .findFirst() .orElse(I) ; } }; public static String encode(long n) { return LongStream.iterate(n, l -> l - Numeral.getLargest(l).weight) .limit(Numeral.values().length) .filter(l -> l > 0) .mapToObj(Numeral::getLargest) .map(String::valueOf) .collect(Collectors.joining()) ; } public static long decode(String roman) { long result = new StringBuilder(roman.toUpperCase()).reverse().chars() .mapToObj(c -> Character.toString((char) c)) .map(numeral -> Enum.valueOf(Numeral.class, numeral)) .mapToLong(numeral -> numeral.weight) .reduce(0, (a, b) -> a + (a <= b ? b : -b)) ; if (roman.charAt(0) == roman.charAt(1)) { result += 2 * Enum.valueOf(Numeral.class, roman.substring(0, 1)).weight; } return result; } public static void test(long n) { System.out.println(n + " = " + encode(n)); System.out.println(encode(n) + " = " + decode(encode(n))); } public static void main(String[] args) { LongStream.of(1999, 25, 944).forEach(RomanNumerals::test); } }  Output: 1999 = MCMXCIX MCMXCIX = 1999 25 = XXV XXV = 25 944 = CMXLIV CMXLIV = 944 ## JavaScript ### ES5 #### Iteration Translation of: Tcl var roman = { map: [ 1000, 'M', 900, 'CM', 500, 'D', 400, 'CD', 100, 'C', 90, 'XC', 50, 'L', 40, 'XL', 10, 'X', 9, 'IX', 5, 'V', 4, 'IV', 1, 'I', ], int_to_roman: function(n) { var value = ''; for (var idx = 0; n > 0 && idx < this.map.length; idx += 2) { while (n >= this.map[idx]) { value += this.map[idx + 1]; n -= this.map[idx]; } } return value; } } roman.int_to_roman(1999); // "MCMXCIX"  #### Functional composition (function () { 'use strict'; // If the Roman is a string, pass any delimiters through // (Int | String) -> String function romanTranscription(a) { if (typeof a === 'string') { var ps = a.split(/\d+/), dlm = ps.length > 1 ? ps[1] : undefined; return (dlm ? a.split(dlm) .map(function (x) { return Number(x); }) : [a]) .map(roman) .join(dlm); } else return roman(a); } // roman :: Int -> String function roman(n) { return [[1000, "M"], [900, "CM"], [500, "D"], [400, "CD"], [100, "C"], [90, "XC"], [50, "L"], [40, "XL"], [10, "X"], [9, "IX"], [5, "V"], [4, "IV"], [1, "I"]] .reduce(function (a, lstPair) { var m = a.remainder, v = lstPair[0]; return (v > m ? a : { remainder: m % v, roman: a.roman + Array( Math.floor(m / v) + 1 ) .join(lstPair[1]) }); }, { remainder: n, roman: '' }).roman; } // TEST return [2016, 1990, 2008, "14.09.2015", 2000, 1666].map( romanTranscription); })();  Output: ["MMXVI", "MCMXC", "MMVIII", "XIV.IX.MMXV", "MM", "MDCLXVI"]  ### ES6 #### Functional Translation of: Haskell (mapAccumL version) (() => { "use strict"; // -------------- ROMAN INTEGER STRINGS -------------- // roman :: Int -> String const roman = n => mapAccumL(residue => ([k, v]) => second( q => 0 < q ? ( k.repeat(q) ) : "" )(remQuot(residue)(v)) )(n)( zip([ "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" ])([ 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 ]) )[1] .join(""); // ---------------------- TEST ----------------------- // main :: IO () const main = () => ( [2016, 1990, 2008, 2000, 2020, 1666].map(roman) ).join("\n"); // ---------------- GENERIC FUNCTIONS ---------------- // mapAccumL :: (acc -> x -> (acc, y)) -> acc -> // [x] -> (acc, [y]) const mapAccumL = f => // A tuple of an accumulation and a list // obtained by a combined map and fold, // with accumulation from left to right. acc => xs => [...xs].reduce( (a, x) => { const tpl = f(a[0])(x); return [ tpl[0], a[1].concat(tpl[1]) ]; }, [acc, []] ); // remQuot :: Int -> Int -> (Int, Int) const remQuot = m => n => [m % n, Math.trunc(m / n)]; // second :: (a -> b) -> ((c, a) -> (c, b)) const second = f => // A function over a simple value lifted // to a function over a tuple. // f (a, b) -> (a, f(b)) xy => [xy[0], f(xy[1])]; // zip :: [a] -> [b] -> [(a, b)] const zip = xs => // The paired members of xs and ys, up to // the length of the shorter of the two lists. ys => Array.from({ length: Math.min(xs.length, ys.length) }, (_, i) => [xs[i], ys[i]]); // MAIN -- return main(); })();  Output: MDCLXVI MCMXC MMVIII MMXVI MMXVIII MMXX #### Declarative function toRoman(num) { return 'I' .repeat(num) .replace(/IIIII/g, 'V') .replace(/VV/g, 'X') .replace(/XXXXX/g, 'L') .replace(/LL/g, 'C') .replace(/CCCCC/g, 'D') .replace(/DD/g, 'M') .replace(/VIIII/g, 'IX') .replace(/LXXXX/g, 'XC') .replace(/XXXX/g, 'XL') .replace(/DCCCC/g, 'CM') .replace(/CCCC/g, 'CD') .replace(/IIII/g, 'IV'); } console.log(toRoman(1666));  Output: MDCLXVI  ## jq Works with: jq Works with gojq, the Go implementation of jq The "easy-to-code" version is presented first, followed by the "orders of magnitude" version. Both versions work for positive integers up to and including 399,999, but note that the Unicode glyphs for 50,000 and 100,000 are not supported in many environments. The test cases and output are identical for both versions and are therefore not repeated. ### Easy-to-code version def to_roman_numeral: def romans: [100000, "\u2188"], [90000, "ↂ\u2188"], [50000, "\u2187"], [40000, "ↂ\u2187"], [10000, "ↂ"], [9000, "Mↂ"], [5000, "ↁ"], [4000, "Mↁ"], [1000, "M"], [900, "CM"], [500, "D"], [400, "CD"], [100, "C"], [90, "XC"], [50, "L"], [40, "XL"], [10, "X"], [9, "IX"], [5, "V"], [4, "IV"], [1, "I"] ; if . < 1 or . > 399999 then "to_roman_numeral: $$.) is out of range" | error else reduce romans as [i, r] ({n: .}; until (.n < i; .res += r | .n = .n - i ) ) | .res end ; Test Cases def testcases: [1668, 1990, 2008, 2020, 4444, 5000, 8999, 39999, 89999, 399999]; "Decimal => Roman:", (testcases[] | " \(.) => \(to_roman_numeral)" ) Output: Decimal => Roman: 1668 => MDCLXVIII 1990 => MCMXC 2008 => MMVIII 2020 => MMXX 4444 => MↁCDXLIV 5000 => ↁ 8999 => ↁMMMCMXCIX 39999 => ↂↂↂMↂCMXCIX 89999 => ↇↂↂↂMↂCMXCIX 399999 => ↈↈↈↂↈMↂCMXCIX  ### "Orders of Magnitude" version Translated from Julia extended to 399,999 def digits: tostring | explode | map( [.]|implode|tonumber); # Non-negative integer to Roman numeral up to 399,999 def to_roman_numeral: if . < 1 or . > 399999 then "to_roman_numeral: \(.) is out of range" | error else [["I", "X", "C", "M", "ↂ", "\u2188"], ["V", "L", "D", "ↁ", "\u2187"]] as DR | (digits|reverse) as digits | reduce range(0;digits|length) as omag ({rnum: ""}; digits[omag] as d | if d == 0 then .omr = "" elif d < 4 then .omr = DR[0][omag] * d elif d == 4 then .omr = DR[0][omag] + DR[1][omag] elif d == 5 then .omr = DR[1][omag] elif d < 9 then .omr = DR[1][omag] + (DR[0][omag] * (d - 5)) else .omr = DR[0][omag] + DR[0][omag+1] end | .rnum = .omr + .rnum ) | .rnum end; ## Jsish This covers both Encode (toRoman) and Decode (fromRoman). /* Roman numerals, in Jsish */ var Roman = { ord: ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'], val: [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1], fromRoman: function(roman:string):number { var n = 0; var re = /IV|IX|I|V|XC|XL|X|L|CD|CM|C|D|M/g; var matches = roman.match(re); if (!matches) return NaN; for (var hit of matches) n += this.val[this.ord.indexOf(hit)]; return n; }, toRoman: function(n:number):string { var roman = ''; var idx = 0; while (n > 0) { while (n >= this.val[idx]) { roman += this.ord[idx]; n -= this.val[idx]; } idx++; } return roman; } }; provide('Roman', 1); if (Interp.conf('unitTest')) { ; Roman.fromRoman('VIII'); ; Roman.fromRoman('MMMDIV'); ; Roman.fromRoman('CDIV'); ; Roman.fromRoman('MDCLXVI'); ; Roman.fromRoman('not'); ; Roman.toRoman(8); ; Roman.toRoman(3504); ; Roman.toRoman(404); ; Roman.toRoman(1666); } /* =!EXPECTSTART!= Roman.fromRoman('VIII') ==> 8 Roman.fromRoman('MMMDIV') ==> 3504 Roman.fromRoman('CDIV') ==> 404 Roman.fromRoman('MDCLXVI') ==> 1666 Roman.fromRoman('not') ==> NaN Roman.toRoman(8) ==> VIII Roman.toRoman(3504) ==> MMMDIV Roman.toRoman(404) ==> CDIV Roman.toRoman(1666) ==> MDCLXVI =!EXPECTEND!= */  Output: prompt jsish -u Roman.jsi [PASS] Roman.jsi ## Julia using Printf function romanencode(n::Integer) if n < 1 || n > 4999 throw(DomainError()) end DR = [["I", "X", "C", "M"] ["V", "L", "D", "MMM"]] rnum = "" for (omag, d) in enumerate(digits(n)) if d == 0 omr = "" elseif d < 4 omr = DR[omag, 1] ^ d elseif d == 4 omr = DR[omag, 1] * DR[omag, 2] elseif d == 5 omr = DR[omag, 2] elseif d < 9 omr = DR[omag, 2] * DR[omag, 1] ^ (d - 5) else omr = DR[omag, 1] * DR[omag + 1, 1] end rnum = omr * rnum end return rnum end testcases = [1990, 2008, 1668] append!(testcases, rand(1:4999, 12)) testcases = unique(testcases) println("Test romanencode, arabic => roman:") for n in testcases @printf("%-4i => %s\n", n, romanencode(n)) end  Output: Test romanencode, arabic => roman: 1990 => MCMXC 2008 => MMVIII 1668 => MDCLXVIII 2928 => MMCMXXVIII 129 => CXXIX 4217 => MMMMCCXVII 1503 => MDIII 2125 => MMCXXV 1489 => MCDLXXXIX 3677 => MMMDCLXXVII 1465 => MCDLXV 1421 => MCDXXI 1642 => MDCXLII 572 => DLXXII 3714 => MMMDCCXIV ## Kotlin val romanNumerals = mapOf( 1000 to "M", 900 to "CM", 500 to "D", 400 to "CD", 100 to "C", 90 to "XC", 50 to "L", 40 to "XL", 10 to "X", 9 to "IX", 5 to "V", 4 to "IV", 1 to "I" ) fun encode(number: Int): String? { if (number > 5000 || number < 1) { return null } var num = number var result = "" for ((multiple, numeral) in romanNumerals.entries) { while (num >= multiple) { num -= multiple result += numeral } } return result } fun main(args: Array<String>) { println(encode(1990)) println(encode(1666)) println(encode(2008)) }  Output: MCMXC MDCLXVI MMVIII  Alternatively: fun Int.toRomanNumeral(): String { fun digit(k: Int, unit: String, five: String, ten: String): String { return when (k) { in 1..3 -> unit.repeat(k) 4 -> unit + five in 5..8 -> five + unit.repeat(k - 5) 9 -> unit + ten else -> throw IllegalArgumentException("k not in range 1..9") } } return when (this) { 0 -> "" in 1..9 -> digit(this, "I", "V", "X") in 10..99 -> digit(this / 10, "X", "L", "C") + (this % 10).toRomanNumeral() in 100..999 -> digit(this / 100, "C", "D", "M") + (this % 100).toRomanNumeral() in 1000..3999 -> "M" + (this - 1000).toRomanNumeral() else -> throw IllegalArgumentException("{this} not in range 0..3999") } }  ## Lasso define br => '\r' // encode roman define encodeRoman(num::integer)::string => { local(ref = array('M'=1000, 'CM'=900, 'D'=500, 'CD'=400, 'C'=100, 'XC'=90, 'L'=50, 'XL'=40, 'X'=10, 'IX'=9, 'V'=5, 'IV'=4, 'I'=1)) local(out = string) with i in #ref do => { while(#num >= #i->second) => { #out->append(#i->first) #num -= #i->second } } return #out } '1990 in roman is '+encodeRoman(1990) br '2008 in roman is '+encodeRoman(2008) br '1666 in roman is '+encodeRoman(1666)  ## LaTeX The macro \Roman is defined for uppercase roman numeral, accepting as argument a name of an existing counter. \documentclass{minimal} \newcounter{currentyear} \setcounter{currentyear}{\year} \begin{document} Anno Domini \Roman{currentyear} \end{document}  ## LiveCode function toRoman intNum local roman,numArabic put "M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I" into romans put "1000,900,500,400,100,90,50,40,10,9,5,4,1" into arabics put intNum into numArabic repeat with n = 1 to the number of items of romans put numArabic div item n of arabics into nums if nums > 0 then put repeatChar(item n of romans,nums) after roman add -(nums * item n of arabics) to numArabic end if end repeat return roman end toRoman function repeatChar c n local cc repeat n times put c after cc end repeat return cc end repeatChar Examples toRoman(2009) -- MMIX toRoman(1666) -- MDCLXVI toRoman(1984) -- MCMLXXXIV toRoman(3888) -- MMMDCCCLXXXVIII ## Logo make "roman.rules [ [1000 M] [900 CM] [500 D] [400 CD] [ 100 C] [ 90 XC] [ 50 L] [ 40 XL] [ 10 X] [ 9 IX] [ 5 V] [ 4 IV] [ 1 I] ] to roman :n [:rules :roman.rules] [:acc "||] if empty? :rules [output :acc] if :n < first first :rules [output (roman :n bf :rules :acc)] output (roman :n - first first :rules :rules word :acc last first :rules) end Works with: UCB Logo make "patterns [[?] [? ?] [? ? ?] [? ?2] [?2] [?2 ?] [?2 ? ?] [?2 ? ? ?] [? ?3]] to digit :d :numerals if :d = 0 [output "||] output apply (sentence "\( "word (item :d :patterns) "$$) :numerals end to digits :n :numerals output word ifelse :n < 10 ["||] [digits int :n/10 bf bf :numerals] ~ digit modulo :n 10 :numerals end to roman :n if or :n < 0 :n >= 4000 [output [EX MODVS!]] output digits :n [I V X L C D M] end print roman 1999 ; MCMXCIX print roman 25 ; XXV print roman 944 ; CMXLIV ## LOLCODE HAI 1.2 I HAS A Romunz ITZ A BUKKIT Romunz HAS A SRS 0 ITZ "M" Romunz HAS A SRS 1 ITZ "CM" Romunz HAS A SRS 2 ITZ "D" Romunz HAS A SRS 3 ITZ "CD" Romunz HAS A SRS 4 ITZ "C" Romunz HAS A SRS 5 ITZ "XC" Romunz HAS A SRS 6 ITZ "L" Romunz HAS A SRS 7 ITZ "XL" Romunz HAS A SRS 8 ITZ "X" Romunz HAS A SRS 9 ITZ "IX" Romunz HAS A SRS 10 ITZ "V" Romunz HAS A SRS 11 ITZ "IV" Romunz HAS A SRS 12 ITZ "I" I HAS A Valuez ITZ A BUKKIT Valuez HAS A SRS 0 ITZ 1000 Valuez HAS A SRS 1 ITZ 900 Valuez HAS A SRS 2 ITZ 500 Valuez HAS A SRS 3 ITZ 400 Valuez HAS A SRS 4 ITZ 100 Valuez HAS A SRS 5 ITZ 90 Valuez HAS A SRS 6 ITZ 50 Valuez HAS A SRS 7 ITZ 40 Valuez HAS A SRS 8 ITZ 10 Valuez HAS A SRS 9 ITZ 9 Valuez HAS A SRS 10 ITZ 5 Valuez HAS A SRS 11 ITZ 4 Valuez HAS A SRS 12 ITZ 1 HOW IZ I Romunize YR Num I HAS A Result ITZ "" IM IN YR Outer UPPIN YR Dummy TIL BOTH SAEM Num AN 0 IM IN YR Inner UPPIN YR Index TIL BOTH SAEM Index AN 13 BOTH SAEM Num AN BIGGR OF Num AN Valuez'Z SRS Index, O RLY? YA RLY Num R DIFF OF Num AN Valuez'Z SRS Index Result R SMOOSH Result Romunz'Z SRS Index MKAY GTFO OIC IM OUTTA YR Inner IM OUTTA YR Outer FOUND YR Result IF U SAY SO VISIBLE SMOOSH 2009 " = " I IZ Romunize YR 2009 MKAY MKAY VISIBLE SMOOSH 1666 " = " I IZ Romunize YR 1666 MKAY MKAY VISIBLE SMOOSH 3888 " = " I IZ Romunize YR 3888 MKAY MKAY KTHXBYE Output: 2009 = MMIX 1666 = MDCLXVI 3888 = MMMDCCCLXXXVIII ## LotusScript Function toRoman(value) As String Dim arabic(12) As Integer Dim roman(12) As String arabic(0) = 1000 arabic(1) = 900 arabic(2) = 500 arabic(3) = 400 arabic(4) = 100 arabic(5) = 90 arabic(6) = 50 arabic(7) = 40 arabic(8) = 10 arabic(9) = 9 arabic(10) = 5 arabic(11) = 4 arabic(12) = 1 roman(0) = "M" roman(1) = "CM" roman(2) = "D" roman(3) = "CD" roman(4) = "C" roman(5) = "XC" roman(6) = "L" roman(7) = "XL" roman(8) = "X" roman(9) = "IX" roman(10) = "V" roman(11) = "IV" roman(12) = "I" Dim i As Integer, result As String 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 ## Lua romans = { {1000, "M"}, {900, "CM"}, {500, "D"}, {400, "CD"}, {100, "C"}, {90, "XC"}, {50, "L"}, {40, "XL"}, {10, "X"}, {9, "IX"}, {5, "V"}, {4, "IV"}, {1, "I"} } k = io.read() + 0 for _, v in ipairs(romans) do --note that this is -not- ipairs. val, let = unpack(v) while k >= val do k = k - val io.write(let) end end print()  ## M4 define(roman',ifelse(eval($1>=1000),1,M'roman(eval($1-1000))', ifelse(eval($1>=900),1,CM'roman(eval($1-900))', ifelse(eval($1>=500),1,D'roman(eval($1-500))', ifelse(eval($1>=100),1,C'roman(eval($1-100))', ifelse(eval($1>=90),1,XC'roman(eval($1-90))', ifelse(eval($1>=50),1,L'roman(eval($1-50))', ifelse(eval($1>=40),1,XL'roman(eval($1-40))', ifelse(eval($1>=10),1,X'roman(eval($1-10))', ifelse(eval($1>=9),1,IX'roman(eval($1-9))', ifelse(eval($1>=5),1,V'roman(eval($1-5))', ifelse(eval($1>=4),1,IV'roman(eval($1-4))', ifelse(eval($1>=1),1,I'roman(eval($1-1))' )')')')')')')')')')')')')dnl dnl roman(3675) Output: MMMDCLXXV  ## Maple > for n in [ 1666, 1990, 2008 ] do printf( "%d\t%s\n", n, convert( n, 'roman' ) ) end: 1666 MDCLXVI 1990 MCMXC 2008 MMVIII ## Mathematica/Wolfram Language RomanNumeral is a built-in function in the Wolfram language. Examples: RomanNumeral[4] RomanNumeral[99] RomanNumeral[1337] RomanNumeral[1666] RomanNumeral[6889]  gives back: IV XCIX MCCCXXXVII MDCLXVI MMMMMMDCCCLXXXIX ## Mercury The non-ceremonial work in this program starts at the function to_roman/1. Unusually for Mercury the function is semi-deterministic. This is because some of the helper functions it calls are also semi-deterministic and the determinism subsystem propagates the status upward. (There are ways to stop it from doing this, but it would distract from the actual Roman numeral conversion process so the semi-determinism has been left in.) to_roman/1 is just a string of chained function calls. The number is passed in as a string (and the main/2 predicate ensures that it is *only* digits!) is converted into a list of characters. This list is then reversed and the Roman numeral version is built from it. This resulting character list is then converted back into a string and returned. build_roman/1 takes the lead character off the list (reversed numerals) and then recursively calls itself. It uses the promote/2 predicate to multiply the ensuing Roman numerals (if any) by an order of magnitude and converts the single remaining digit to the appropriate list of Roman numerals. To clarify, if it's passed the number "123" (encoded by this point as ['3', '2', '1']) the following transpires: • The '3' is removed and build_roman/1 is now called with ['2', '1']. • The '2' is removed and the function is recursively called with ['1']. • The '1' is removed and the function is recursively called with [] (the empty list).. • The function returns []. • The [] has its (non-existent) digits promoted and then gets ['I'] appended (1 converts to ['I'] via digit_to_roman/1). • The ['I'] has its (single) digit promoted and is converted to ['X'] and then gets ['I','I'] appended from the 2's conversion. The resulting list is now ['X','I','I'] (or 12). • The ['X','I','I'] has all of its digits promoted, yielding ['C','X','X'] before getting ['I','I','I'] appended. The resulting list is now ['C','X','X','I','I','I'] which is converted into the string "CXXIII" back up in to_roman/1. It is possible for this to be implemented differently even keeping the same algorithm. For example the map module from the standard library could be used for looking up conversions and promotions instead of having digit_to_roman/1 and promote. This would require, however, either passing around the conversion tables constantly (bulking up the parameter lists of all functions and predicates) or creating said conversion tables each time at point of use (slowing down the implementation greatly). Now the semi-determinism of the functions involved is a little bit of a problem. In the main/2 predicate you can see one means of dealing with it. main/2 *must* be deterministic (or cc_multi, but this is equivalent for this discussion). There can be *no* failure in a called function or predicate … unless that failure is explicitly handled somehow. In this implementation the failure is handled in the foldl/4's provided higher-order predicate lambda. The call to to_roman/1 is called within a conditional and both the success (true) and failure (false) branches are handled. This makes the passed-in predicate lambda deterministic, even though the implementation functions and predicates are semi-deterministic. But why are they semi-deterministic? Well, this has to do with the type system. It doesn't permit sub-typing, so when the type of a predicate is, say pred(char, char) (as is the case for promote/2), the underlying implementation *must* handle *all* values that a type char could possibly hold. It is trivial to see that our code does not. This means that, in theory, it is possible that promote/2 (or digit_to_roman/1) could be passed a value which cannot be processed, thus triggering a false result, and thus being semi-deterministic. ### roman.m :- module roman. :- interface. :- import_module io. :- pred main(io::di, io::uo) is det. :- implementation. :- import_module char, int, list, string. main(!IO) :- command_line_arguments(Args, !IO), filter(is_all_digits, Args, CleanArgs), foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :- ( Roman = to_roman(Arg) -> format("%s => %s", [s(Arg), s(Roman)], !IO), nl(!IO) ; format("%s cannot be converted.", [s(Arg)], !IO), nl(!IO) ) ), CleanArgs, !IO). :- func to_roman(string::in) = (string::out) is semidet. to_roman(Number) = from_char_list(build_roman(reverse(to_char_list(Number)))). :- func build_roman(list(char)) = list(char). :- mode build_roman(in) = out is semidet. build_roman([]) = []. build_roman([D|R]) = Roman :- map(promote, build_roman(R), Interim), Roman = Interim ++ digit_to_roman(D). :- func digit_to_roman(char) = list(char). :- mode digit_to_roman(in) = out is semidet. digit_to_roman('0') = []. digit_to_roman('1') = ['I']. digit_to_roman('2') = ['I','I']. digit_to_roman('3') = ['I','I','I']. digit_to_roman('4') = ['I','V']. digit_to_roman('5') = ['V']. digit_to_roman('6') = ['V','I']. digit_to_roman('7') = ['V','I','I']. digit_to_roman('8') = ['V','I','I','I']. digit_to_roman('9') = ['I','X']. :- pred promote(char::in, char::out) is semidet. promote('I', 'X'). promote('V', 'L'). promote('X', 'C'). promote('L', 'D'). promote('C', 'M'). :- end_module roman. Output: $ '''mmc roman && ./roman 1 8 27 64 125 216 343 512 729 1000 1331 1728 2197 2744 3375'''
''1 => I''
''8 => VIII''
''27 => XXVII''
''64 => LXIV''
''125 => CXXV''
''216 => CCXVI''
''343 => CCCXLIII''
''512 => DXII''
''729 => DCCXXIX''
''1000 => M''
''1331 => MCCCXXXI''
''1728 => MDCCXXVIII''
''2197 => MMCXCVII''
''2744 => MMDCCXLIV''
''3375 => MMMCCCLXXV''


### roman2.m

Another implementation using an algorithm inspired by the Erlang implementation could look like this:

:- module roman2.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.

:- import_module char, int, list, string.

main(!IO) :-
command_line_arguments(Args, !IO),
filter_map(to_int, Args, CleanArgs),
foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :-
( Roman = to_roman(Arg) ->
format("%i => %s",
[i(Arg), s(from_char_list(Roman))], !IO),
nl(!IO)
;     format("%i cannot be converted.", [i(Arg)], !IO), nl(!IO) )
), CleanArgs, !IO).

:- func to_roman(int) = list(char).
:- mode to_roman(in)  = out is semidet.
to_roman(N) = ( N >= 1000 ->
['M'] ++ to_roman(N - 1000)
;( N >= 100 ->
digit(N / 100, 'C', 'D', 'M') ++ to_roman(N rem 100)
;( N >= 10 ->
digit(N / 10, 'X', 'L', 'C') ++ to_roman(N rem 10)
;( N >= 1 ->
digit(N, 'I', 'V', 'X')
; [] ) ) ) ).

:- func digit(int, char, char, char) = list(char).
:- mode digit(in,  in,   in,   in)   = out is semidet.
digit(1, X, _, _) = [X].
digit(2, X, _, _) = [X, X].
digit(3, X, _, _) = [X, X, X].
digit(4, X, Y, _) = [X, Y].
digit(5, _, Y, _) = [Y].
digit(6, X, Y, _) = [Y, X].
digit(7, X, Y, _) = [Y, X, X].
digit(8, X, Y, _) = [Y, X, X, X].
digit(9, X, _, Z) = [X, Z].

:- end_module roman2.

This implementation calculates the value of the thousands, then the hundreds, then the tens, then the ones. In each case it uses the digit/4 function and some tricks with unification to build the appropriate list of characters for the digit and multiplier being targeted.

Its output is identical to that of the previous version.

## Modula-2

Translation of: DWScript
Works with: ADW Modula-2 version any (Compile with the linker option Console Application).
MODULE RomanNumeralsEncode;

FROM Strings IMPORT
Append;
FROM STextIO IMPORT
WriteString, WriteLn;

CONST
MaxChars = 15;
(* 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded
with these symbols. *)

TYPE
TRomanNumeral = ARRAY [0 .. MaxChars - 1] OF CHAR;

PROCEDURE ToRoman(AValue: CARDINAL; VAR OUT Destination: ARRAY OF CHAR);
TYPE
TRomanSymbols = ARRAY [0 .. 1] OF CHAR;
TWeights = ARRAY [0 .. 12] OF CARDINAL;
TSymbols = ARRAY [0 .. 12] OF TRomanSymbols;
CONST
Weights = TWeights {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1};
Symbols = TSymbols {"M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX",
"V", "IV", "I"};
VAR
I: CARDINAL;
BEGIN
Destination := "";
I := 0;
WHILE (I <= HIGH(Weights)) AND (AValue > 0) DO
WHILE AValue >= Weights[I] DO
Append(Symbols[I], Destination);
AValue := AValue - Weights[I]
END;
INC(I);
END;
END ToRoman;

VAR
Numeral: TRomanNumeral;

BEGIN
ToRoman(1990, Numeral); WriteString(Numeral); WriteLn; (* MCMXC *)
ToRoman(2018, Numeral); WriteString(Numeral); WriteLn; (* MMXVIII *)
ToRoman(3888, Numeral); WriteString(Numeral); WriteLn; (* MMMDCCCLXXXVIII *)
END RomanNumeralsEncode.

Output:
MCMXC
MMXVIII
MMMDCCCLXXXVIII


## MUMPS

TOROMAN(INPUT)
;Converts INPUT into a Roman numeral. INPUT must be an integer between 1 and 3999
;OUTPUT is the string to return
;I is a loop variable
;CURRVAL is the current value in the loop
QUIT:($FIND(INPUT,".")>1)!(INPUT<=0)!(INPUT>3999) "Invalid input" NEW OUTPUT,I,CURRVAL SET OUTPUT="",CURRVAL=INPUT SET:$DATA(ROMANNUM)=0 ROMANNUM="I^IV^V^IX^X^XL^L^XC^C^CD^D^CM^M"
SET:$DATA(ROMANVAL)=0 ROMANVAL="1^4^5^9^10^40^50^90^100^400^500^900^1000" FOR I=$LENGTH(ROMANVAL,"^"):-1:1 DO
.FOR  Q:CURRVAL<$PIECE(ROMANVAL,"^",I) SET OUTPUT=OUTPUT_$PIECE(ROMANNUM,"^",I),CURRVAL=CURRVAL-PIECE(ROMANVAL,"^",I) KILL I,CURRVAL QUIT OUTPUT Output: USER>W $$ROMAN^ROSETTA(1666) MDCLXVI USER>W$$TOROMAN^ROSETTA(2010) MMX USER>W $$TOROMAN^ROSETTA(949) CMXLIX USER>W$$TOROMAN^ROSETTA(949.24) Invalid input USER>W TOROMAN^ROSETTA(-949) Invalid input Another variant TOROMAN(n) ;return empty string if input parameter 'n' is not in 1-3999 Quit:(n'?1.4N)!(n'<4000)!'n "" New r Set r="" New p Set p=Length(n) New j,x For j=1:1:p Do . Set x=Piece("~I~II~III~IV~V~VI~VII~VIII~IX","~",Extract(n,j)+1) . Set x=Translate(x,"IVX",Piece("IVX~XLC~CDM~M","~",p-j+1)) . Set r=r_x Quit r ## Nim Translation of: Python import strutils const nums = [(1000, "M"), (900, "CM"), (500, "D"), (400, "CD"), (100, "C"), (90, "XC"), (50, "L"), (40, "XL"), (10, "X"), (9, "IX"), (5, "V"), (4, "IV"), (1, "I")] proc toRoman(n: Positive): string = var n = n.int for (a, r) in nums: result.add(repeat(r, n div a)) n = n mod a for i in [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 25, 30, 40, 50, 60, 69, 70, 80, 90, 99, 100, 200, 300, 400, 500, 600, 666, 700, 800, 900, 1000, 1009, 1444, 1666, 1945, 1997, 1999, 2000, 2008, 2010, 2011, 2500, 3000, 3999]: echo (i).align(4), ": ", i.toRoman  Output:  1: I 2: II 3: III 4: IV 5: V 6: VI 7: VII 8: VIII 9: IX 10: X 11: XI 12: XII 13: XIII 14: XIV 15: XV 16: XVI 17: XVII 18: XVIII 19: XIX 20: XX 25: XXV 30: XXX 40: XL 50: L 60: LX 69: LXIX 70: LXX 80: LXXX 90: XC 99: XCIX 100: C 200: CC 300: CCC 400: CD 500: D 600: DC 666: DCLXVI 700: DCC 800: DCCC 900: CM 1000: M 1009: MIX 1444: MCDXLIV 1666: MDCLXVI 1945: MCMXLV 1997: MCMXCVII 1999: MCMXCIX 2000: MM 2008: MMVIII 2010: MMX 2011: MMXI 2500: MMD 3000: MMM 3999: MMMCMXCIX ## Objeck Translation of: C sharp bundle Default { class Roman { nums: static : Int[]; rum : static : String[]; function : Init() ~ Nil { nums := [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]; rum := ["M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"]; } function : native : ToRoman(number : Int) ~ String { result := ""; for(i :=0; i < nums->Size(); i += 1;) { while(number >= nums[i]) { result->Append(rum[i]); number -= nums[i]; }; }; return result; } function : Main(args : String[]) ~ Nil { Init(); ToRoman(1999)->PrintLine(); ToRoman(25)->PrintLine(); ToRoman(944)->PrintLine(); } } } ## OCaml With an explicit decimal digit representation list: let digit x y z = function 1 -> [x] | 2 -> [x;x] | 3 -> [x;x;x] | 4 -> [x;y] | 5 -> [y] | 6 -> [y;x] | 7 -> [y;x;x] | 8 -> [y;x;x;x] | 9 -> [x;z] let rec to_roman x = if x = 0 then [] else if x < 0 then invalid_arg "Negative roman numeral" else if x >= 1000 then 'M' :: to_roman (x - 1000) else if x >= 100 then digit 'C' 'D' 'M' (x / 100) @ to_roman (x mod 100) else if x >= 10 then digit 'X' 'L' 'C' (x / 10) @ to_roman (x mod 10) else digit 'I' 'V' 'X' x  Output: # to_roman 1999;; - : char list = ['M'; 'C'; 'M'; 'X'; 'C'; 'I'; 'X'] # to_roman 25;; - : char list = ['X'; 'X'; 'V'] # to_roman 944;; - : char list = ['C'; 'M'; 'X'; 'L'; 'I'; 'V']  ## Oforth [ [1000,"M"], [900,"CM"], [500,"D"], [400,"CD"], [100,"C"], [90,"XC"], [50,"L"], [40,"XL"], [10,"X"], [9,"IX"], [5,"V"], [4,"IV"], [1,"I"] ] const: Romans : roman(n) | r | StringBuffer new Romans forEach: r [ while(r first n <=) [ r second << n r first - ->n ] ] ; ## OpenEdge/Progress FUNCTION encodeRoman RETURNS CHAR ( i_i AS INT ): DEF VAR cresult AS CHAR. DEF VAR croman AS CHAR EXTENT 7 INIT [ "M", "D", "C", "L", "X", "V", "I" ]. DEF VAR idecimal AS INT EXTENT 7 INIT [ 1000, 500, 100, 50, 10, 5, 1 ]. DEF VAR ipos AS INT INIT 1. DO WHILE i_i > 0: IF i_i - idecimal[ ipos ] >= 0 THEN ASSIGN cresult = cresult + croman[ ipos ] i_i = i_i - idecimal[ ipos ] . ELSE IF ipos < EXTENT( croman ) - 1 AND i_i - ( idecimal[ ipos ] - idecimal[ ipos + 2 ] ) >= 0 THEN ASSIGN cresult = cresult + croman[ ipos + 2 ] + croman[ ipos ] i_i = i_i - ( idecimal[ ipos ] - idecimal[ ipos + 2 ] ) ipos = ipos + 1 . ELSE ipos = ipos + 1. END. RETURN cresult. END FUNCTION. /* encodeRoman */ MESSAGE 1990 encodeRoman( 1990 ) SKIP 2008 encodeRoman( 2008 ) SKIP 2000 encodeRoman( 2000 ) SKIP 1666 encodeRoman( 1666 ) SKIP VIEW-AS ALERT-BOX.  Output: --------------------------- Message (Press HELP to view stack trace) --------------------------- 1990 MCMXC 2008 MMVIII 2000 MM 1666 MDCLXVI --------------------------- OK Help --------------------------- ## Oz Translation of: Haskell declare fun {Digit X Y Z K} unit([X] [X X] [X X X] [X Y] [Y] [Y X] [Y X X] [Y X X X] [X Z]) .K end fun {ToRoman X} if X == 0 then "" elseif X < 0 then raise toRoman(negativeInput X) end elseif X >= 1000 then "M"#{ToRoman X-1000} elseif X >= 100 then {Digit &C &D &M X div 100}#{ToRoman X mod 100} elseif X >= 10 then {Digit &X &L &C X div 10}#{ToRoman X mod 10} else {Digit &I &V &X X} end end in {ForAll {Map [1999 25 944] ToRoman} System.showInfo} ## PARI/GP Old-style Roman numerals oldRoman(n)={ while(n>999999, n-=1000000; print1("((((I))))") ); if(n>499999, n-=500000; print1("I))))") ); while(n>99999, n-=100000; print1("(((I)))") ); if(n>49999, n-=50000; print1("I)))") ); while(n>9999, n-=10000; print1("((I))") ); if(n>4999, n-=5000; print1("I))") ); while(n>999, n-=1000; print1("(I)") ); if(n>499, n-=500; print1("I)") ); while(n>99, n-=100; print1("C") ); if(n>49, n-=50; print1("L"); ); while(n>9, n-=10; print1("X") ); if(n>4, n-=5; print1("V"); ); while(n, n--; print1("I") ); print() }; This simple version of medieval Roman numerals does not handle large numbers. medievalRoman(n)={ while(n>999, n-=1000; print1("M") ); if(n>899, n-=900; print1("CM") ); if(n>499, n-=500; print1("D") ); if(n>399, n-=400; print1("CD") ); while(n>99, n-=100; print1("C") ); if(n>89, n-=90; print1("XC") ); if(n>49, n-=50; print1("L") ); if(n>39, n-=40; print1("XL") ); while(n>9, n-=10; print1("X") ); if(n>8, n-=9; print1("IX") ); if(n>4, n-=5; print1("V") ); if(n>3, n-=4; print1("IV") ); while(n, n--; print1("I") ); print() }; ## Pascal See Delphi ## Peloton Roman numbers are built in to Peloton as a particular form of national number. However, for the sake of the task the _RO opcode has been defined. <@ DEFUDOLITLIT>_RO|__Transformer|<@ DEFKEYPAR>__NationalNumericID|2</@><@ LETRESCS%NNMPAR>...|1</@></@> <@ ENUDLSTLITLIT>1990,2008,1,2,64,124,1666,10001|,| <@ SAYELTLST>...</@> is <@ SAY_ROELTLSTLIT>...|RomanLowerUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanUpperUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanASCII</@> </@> Same code in padded-out, variable-length English dialect <# DEFINE USERDEFINEDOPCODE LITERAL LITERAL>_RO|__Transformer|<# DEFINE KEYWORD PARAMETER>__NationalNumericID|2</#><# LET RESULT CAST NATIONALNUMBER PARAMETER>...|1</#></#> <# ENUMERATION LAMBDASPECIFIEDDELMITER LIST LITERAL LITERAL>1990,2008,1,2,64,124,1666,10001|,| <# SAY ELEMENT LIST>...</#> is <# SAY _RO ELEMENT LIST LITERAL>...|RomanLowerUnicode</#> <# SAY _RO ELEMENT LIST LITERAL>...|RomanUpperUnicode</#> <# SAY _RO ELEMENT LIST LITERAL>...|RomanASCII</#> </#> Output: Notice here the three different ways of representing the results. For reasons for notational differences, see wp:Roman_numerals#Alternate_forms 1990 is ⅿⅽⅿⅹⅽ ⅯⅭⅯⅩⅭ MCMXC 2008 is ⅿⅿⅷ ⅯⅯⅧ MMVIII 1 is ⅰ Ⅰ I 2 is ⅱ Ⅱ II 64 is ⅼⅹⅳ ⅬⅩⅣ LXIV 124 is ⅽⅹⅹⅳ ⅭⅩⅩⅣ CXXIV 1666 is ⅿⅾⅽⅼⅹⅵ ⅯⅮⅭⅬⅩⅥ MDCLXVI 10001 is ⅿⅿⅿⅿⅿⅿⅿⅿⅿⅿⅰ ↂⅠ MMMMMMMMMMI ## Perl #### Simple program Simple, fast, produces same output as the Math::Roman module and the Raku example, less crazy than writing a Latin program, and doesn't require experimental modules like the Raku translation. my @symbols = ( [1000, 'M'], [900, 'CM'], [500, 'D'], [400, 'CD'], [100, 'C'], [90, 'XC'], [50, 'L'], [40, 'XL'], [10, 'X'], [9, 'IX'], [5, 'V'], [4, 'IV'], [1, 'I'] ); sub roman { my(n, $r) = (shift, ''); ($r, $n) = ('-', -$n) if $n < 0; # Optional handling of negative input foreach my$s (@symbols) {
my($arabic,$roman) = @$s; ($r, $n) = ($r .= $roman x int($n/$arabic),$n % $arabic) if$n >= $arabic; }$r;
}



#### Ported version of Raku

use List::MoreUtils qw( natatime );

my %symbols = (
1 => "I", 5 => "V", 10 => "X", 50 => "L", 100 => "C",
500 => "D", 1_000 => "M"
);

my @subtractors = (
1_000, 100,  500, 100,  100, 10,  50, 10,  10, 1,  5, 1,  1, 0
);

sub roman {
return '' if 0 == (my $n = shift); my$iter = natatime 2, @subtractors;
while( my ($cut,$minus) = $iter->() ) {$n >= $cut and return$symbols{$cut} . roman($n - $cut);$n >= $cut -$minus
and return $symbols{$minus} . roman($n +$minus);
}
};

print roman($_) . "\n" for 1..2012;  ## Phix function toRoman(integer v) constant roman = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}, decml = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 } string res = "" integer val = v for i=1 to length(roman) do while val>=decml[i] do res &= roman[i] val -= decml[i] end while end for -- return res return {v,res} -- (for output) end function ?apply({1990,2008,1666},toRoman)  Output: {{1990,"MCMXC"},{2008,"MMVIII"},{1666,"MDCLXVI"}}  ## Phixmonti include ..\Utilitys.pmt def romanEnc /# n -- s #/ var number "" var res ( ( 1000 "M" ) ( 900 "CM" ) ( 500 "D" ) ( 400 "CD" ) ( 100 "C" ) ( 90 "XC" ) ( 50 "L" ) ( 40 "XL" ) ( 10 "X" ) ( 9 "IX" ) ( 5 "V" ) ( 4 "IV" ) ( 1 "I" ) ) len for get 1 get number over / int number rot mod var number swap 2 get rot dup if for drop res over chain var res endfor else drop endif drop drop endfor drop res enddef 1968 romanEnc print Translation of: Lua def romanEnc /# n -- s #/ var k ( ( 1000 "M" ) ( 900 "CM" ) ( 500 "D" ) ( 400 "CD" ) ( 100 "C" ) ( 90 "XC" ) ( 50 "L" ) ( 40 "XL" ) ( 10 "X" ) ( 9 "IX" ) ( 5 "V" ) ( 4 "IV" ) ( 1 "I" ) ) len for get 2 get var let 1 get var val drop k val >= while k val - var k let print k val >= endwhile endfor drop nl enddef 1968 romanEnc Without vars def romanEnc /# n -- s #/ >ps ( ( 1000 "M" ) ( 900 "CM" ) ( 500 "D" ) ( 400 "CD" ) ( 100 "C" ) ( 90 "XC" ) ( 50 "L" ) ( 40 "XL" ) ( 10 "X" ) ( 9 "IX" ) ( 5 "V" ) ( 4 "IV" ) ( 1 "I" ) ) len for get 2 get swap 1 get nip tps over >= while ps> over - >ps over print tps over >= endwhile drop drop endfor ps> drop drop nl enddef 1968 romanEnc ## PHP Works with: PHP version 4+ tested in 5.2.12 /** * int2roman * Convert any positive value of a 32-bit signed integer to its modern roman * numeral representation. Numerals within parentheses are multiplied by * 1000. ie. M == 1 000, (M) == 1 000 000, ((M)) == 1 000 000 000 * * @param number - an integer between 1 and 2147483647 * @return roman numeral representation of number */ function int2roman($number)
{
if (!is_int($number) ||$number < 1) return false; // ignore negative numbers and zero

$integers = array(900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1);$numerals = array('CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I');
$major = intval($number / 1000) * 1000;
$minor =$number - $major;$numeral = $leastSig = ''; for ($i = 0; $i < sizeof($integers); $i++) { while ($minor >= $integers[$i]) {
$leastSig .=$numerals[$i];$minor  -= $integers[$i];
}
}

if ($number >= 1000 &&$number < 40000) {
if ($major >= 10000) {$numeral .= '(';
while ($major >= 10000) {$numeral .= 'X';
$major -= 10000; }$numeral .= ')';
}
if ($major == 9000) {$numeral .= 'M(X)';
return $numeral .$leastSig;
}
if ($major == 4000) {$numeral .= 'M(V)';
return $numeral .$leastSig;
}
if ($major >= 5000) {$numeral .= '(V)';
$major -= 5000; } while ($major >= 1000) {
$numeral .= 'M';$major -= 1000;
}
}

if ($number >= 40000) {$major = $major/1000;$numeral .= '(' . int2roman($major) . ')'; } return$numeral . $leastSig; }  ## Picat go => List = [455,999,1990,1999,2000,2001,2008,2009,2010,2011,2012,1666,3456,3888,4000], foreach(Val in List) printf("%4d: %w\n", Val, roman_encode(Val)) end, nl. roman_encode(Val) = Res => if Val <= 0 then Res := -1 else Arabic = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1], Roman = ["M", "CM", "D", "CD", "C", "XC","L","XL","X","IX","V","IV","I"], Res = "", foreach(I in 1..Arabic.length) while(Val >= Arabic[I]) Res := Res ++ Roman[I], Val := Val - Arabic[I] end end end. Output:  455: CDLV 999: CMXCIX 1990: MCMXC 1999: MCMXCIX 2000: MM 2001: MMI 2008: MMVIII 2009: MMIX 2010: MMX 2011: MMXI 2012: MMXII 1666: MDCLXVI 3456: MMMCDLVI 3888: MMMDCCCLXXXVIII 4000: MMMM ### Longest numeral Which number encodes to the longest Roman numerals in the interval 1..4000: go2 => All = [Len=I=roman_encode(I) : I in 1..4000,E=roman_encode(I), Len=E.len].sort_down, println(All[1..2]), nl. Output: [15 = 3888 = MMMDCCCLXXXVIII,14 = 3887 = MMMDCCCLXXXVII] ## PicoLisp (de roman (N) (pack (make (mapc '((C D) (while (>= N D) (dec 'N D) (link C) ) ) '(M CM D CD C XC L XL X IX V IV I) (1000 900 500 400 100 90 50 40 10 9 5 4 1) ) ) ) ) Output: : (roman 1009) -> "MIX" : (roman 1666) -> "MDCLXVI" ## Pike import String; int main(){ write(int2roman(2009) + "\n"); write(int2roman(1666) + "\n"); write(int2roman(1337) + "\n"); }  ## PL/I /* From Wiki Fortran */ roman: procedure (n) returns(character (32) varying); declare n fixed binary nonassignable; declare (d, m) fixed binary; declare (r, m_div) character (32) varying; declare d_dec(13) fixed binary static initial (1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1); declare d_rom(13) character (2) varying static initial ('M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'); r = ''; m = n; do d = 1 to 13; m_div = m / d_dec (d); r = r || copy (d_rom (d), m_div); m = m - d_dec (d) * m_div; end; return (r); end roman; Results:  11 XI 1990 MCMXC 2008 MMVIII 1666 MDCLXVI 1999 MCMXCIX  ## PL/SQL /***************************************************************** *$Author: Atanas Kebedjiev $***************************************************************** * Encoding an Arabic numeral to a Roman in the range 1..3999 is much simpler as Oracle provides the conversion formats. * Please see also the SQL solution for the same task. */ CREATE OR REPLACE FUNCTION rencode(an IN NUMBER) RETURN VARCHAR2 IS BEGIN RETURN to_char(an, 'RN'); END rencode; BEGIN DBMS_OUTPUT.PUT_LINE ('2012 = ' || rencode('2012')); -- MMXII DBMS_OUTPUT.PUT_LINE ('1951 = ' || rencode('1951')); -- MCMLI DBMS_OUTPUT.PUT_LINE ('1987 = ' || rencode('1987')); -- MCMLXXXVII DBMS_OUTPUT.PUT_LINE ('1666 = ' || rencode('1666')); -- MDCLXVI DBMS_OUTPUT.PUT_LINE ('1999 = ' || rencode('1999')); -- MCMXCIX END; ## Plain TeX TeX has its own way to convert a number into roman numeral, but it produces lowercase letters; the following macro (and usage example), produce uppercase roman numeral. \def\upperroman#1{\uppercase\expandafter{\romannumeral#1}} Anno Domini \upperroman{\year} \bye  ## PowerShell Filter ToRoman {$output = ''

if ($_ -ge 4000) { throw 'Number too high' }$current = 1000
$subtractor = 'M'$whole = $False$decimal = $_ 'C','D','X','L','I','V',' '  | %{$divisor = $current if ($whole = !$whole) {$current /= 10
$subtractor =$_ + $subtractor[0]$_ = $subtractor[1] } else {$divisor *= 5
$subtractor =$subtractor[0] + $_ }$multiple = [Math]::floor($decimal /$divisor)
if ($multiple) {$output += [string]$_ *$multiple
$decimal %=$divisor
}
if ($decimal -ge ($divisor -= $current)) {$output += $subtractor$decimal -= $divisor } }$output
}

19,4,0,2479,3001 | ToRoman

Output:
XIX
IV

MMCDLXXIX
MMMI


## Prolog

Works with: SWI-Prolog
Library: clpfd

Library clpfd assures that the program works in both managements : Roman towards Arabic and Arabic towards Roman.

:- use_module(library(clpfd)).

roman :-
LA =  [    _       , 2010,    _, 1449,         _],
LR =  ['MDCCLXXXIX',  _  , 'CX',    _, 'MDCLXVI'],
maplist(roman,   LA, LR),
maplist(my_print,LA, LR).

roman(A, R) :-
A #> 0,
roman(A, [u, t, h, th], LR, []),
label([A]),
parse_Roman(CR, LR, []),
atom_chars(R, CR).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% using DCG

roman(0, []) --> [].

roman(N, [H | T]) -->
{N1 #= N / 10,
N2 #= N mod 10},
roman(N1, T),
unity(N2, H).

unity(1, u) --> ['I'].
unity(1, t) --> ['X'].
unity(1, h) --> ['C'].
unity(1, th)--> ['M'].

unity(4, u) --> ['IV'].
unity(4, t) --> ['XL'].
unity(4, h) --> ['CD'].
unity(4, th)--> ['MMMM'].

unity(5, u) --> ['V'].
unity(5, t) --> ['L'].
unity(5, h) --> ['D'].
unity(5, th)--> ['MMMMM'].

unity(9, `