Roman numerals/Encode: Difference between revisions
more concise Fortran program |
PascalABC.NET |
||
(520 intermediate revisions by more than 100 users not shown) | |||
Line 1: | Line 1: | ||
{{task}} |
{{task}} |
||
[[Category:String_manipulation]] |
|||
Create a function taking a positive integer as its parameter and returning a string containing the Roman Numeral representation of that integer. |
|||
{{omit from|GUISS}} |
|||
;Task: |
|||
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. |
|||
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 |
|||
<br><br> |
|||
=={{header|11l}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="11l">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))</syntaxhighlight> |
|||
=={{header|360 Assembly}}== |
|||
<syntaxhighlight lang="360asm">* Roman numerals Encode - 11/05/2020 |
|||
ROMAENC CSECT |
|||
USING ROMAENC,R13 base register |
|||
B 72(R15) skip savearea |
|||
DC 17F'0' savearea |
|||
SAVE (14,12) save previous context |
|||
ST R13,4(R15) link backward |
|||
ST R15,8(R13) link forward |
|||
LR R13,R15 set addressability |
|||
LA R6,1 i=1 |
|||
DO WHILE=(C,R6,LE,=A(8)) do i=1 to hbound(nums) |
|||
LR R1,R6 i |
|||
SLA R1,1 ~ |
|||
LH R8,NUMS-2(R1) n=nums(i) |
|||
MVC PG,=CL80'.... :' clear buffer |
|||
LA R9,PG @pg |
|||
XDECO R8,XDEC edit n |
|||
MVC 0(4,R9),XDEC+8 output n |
|||
LA R9,7(R9) @pg+=7 |
|||
LA R7,1 j=1 |
|||
DO WHILE=(C,R7,LE,=A(13)) do j=1 to 13 |
|||
LR R1,R7 j |
|||
SLA R1,1 ~ |
|||
LH R3,ARABIC-2(R1) aj=arabic(j) |
|||
DO WHILE=(CR,R8,GE,R3) while n>=aj |
|||
LR R1,R7 j |
|||
SLA R1,1 ~ |
|||
LA R4,ROMAN-2(R1) roman(j) |
|||
MVC 0(2,R9),0(R4) output roman(j) |
|||
IF CLI,1(R9),NE,C' ' THEN if roman(j)[2]=' ' then |
|||
LA R9,2(R9) @pg+=2 |
|||
ELSE , else |
|||
LA R9,1(R9) @pg+=1 |
|||
ENDIF , endif |
|||
SR R8,R3 n-=aj |
|||
ENDDO , endwile |
|||
LA R7,1(R7) j++ |
|||
ENDDO , enddo j |
|||
XPRNT PG,L'PG print buffer |
|||
LA R6,1(R6) i++ |
|||
ENDDO , enddo i |
|||
L R13,4(0,R13) restore previous savearea pointer |
|||
RETURN (14,12),RC=0 restore registers from calling save |
|||
ARABIC DC H'1000',H'900',H'500',H'400',H'100',H'90' |
|||
DC H'50',H'40',H'10',H'9',H'5',H'4',H'1' |
|||
ROMAN DC CL2'M',CL2'CM',CL2'D',CL2'CD',CL2'C',CL2'XC' |
|||
DC CL2'L',CL2'XL',CL2'X',CL2'IX',CL2'V',CL2'IV',CL2'I' |
|||
NUMS DC H'14',H'16',H'21',H'888',H'1492',H'1999',H'2020',H'3999' |
|||
PG DS CL80 buffer |
|||
XDEC DS CL12 temp for xdeco |
|||
REGEQU |
|||
END ROMAENC</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
14 : XIV |
|||
16 : XVI |
|||
21 : XXI |
|||
888 : DCCCLXXXVIII |
|||
1492 : MCDXCII |
|||
1999 : MCMXCIX |
|||
2020 : MMXX |
|||
3999 : MMMCMXCIX |
|||
</pre> |
|||
=={{header|8080 Assembly}}== |
|||
<syntaxhighlight lang="8080asm"> 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 |
|||
xthl ; load number |
|||
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 |
|||
xthl ; load number |
|||
xra a ; find how many we need |
|||
subtract: inr a ; with trial subtraction |
|||
dad d |
|||
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 |
|||
dad d |
|||
pop d ; restore counter (into D) |
|||
xthl ; load table pointer |
|||
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 70h,0feh,'CD',0 ; added using `dad'. |
|||
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 |
|||
readdgt: ldax b |
|||
ana a |
|||
jz convert |
|||
dad h ; hl *= 10 |
|||
mov d,h |
|||
mov e,l |
|||
dad h |
|||
dad h |
|||
dad d |
|||
sui '0' |
|||
mov e,a |
|||
mvi d,0 |
|||
dad d |
|||
inx b |
|||
jmp readdgt |
|||
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:</syntaxhighlight> |
|||
=={{header|8086 Assembly}}== |
|||
===Main and Supporting Functions=== |
|||
The main program and test values: 70,1776,2021,3999,4000 |
|||
<syntaxhighlight lang="asm"> 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</syntaxhighlight> |
|||
The <code>EncodeRoman</code> routine: |
|||
<syntaxhighlight lang="asm">;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 |
|||
LoadSegment ds,ax,@data |
|||
mov al,01h |
|||
mov byte ptr [ds:error_code],al |
|||
mov ax, offset EncodeRoman |
|||
mov word ptr [ds:error_routine],ax |
|||
LoadSegment ds,ax,@code |
|||
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" |
|||
Roman_Error db "ERROR: BAD INPUT",0 |
|||
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</syntaxhighlight> |
|||
Macros used: |
|||
<syntaxhighlight lang="asm">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</syntaxhighlight> |
|||
===Output=== |
|||
{{out}} |
|||
<pre> |
|||
LXX |
|||
MDCCLXXVI |
|||
MMXXI |
|||
MMMCMXCIX |
|||
ERROR: BAD INPUT |
|||
</pre> |
|||
=={{header|Action!}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{out}} |
|||
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Roman_numerals_encode.png Screenshot from Atari 8-bit computer] |
|||
<pre> |
|||
1990=MCMXC |
|||
2008=MMVIII |
|||
5555=MMMMMDLV |
|||
1666=MDCLXVI |
|||
3888=MMMDCCCLXXXVIII |
|||
3999=MMMCMXCIX |
|||
</pre> |
|||
=={{header|ActionScript}}== |
|||
<syntaxhighlight lang="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)); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990 in roman is MCMXC |
|||
2008 in roman is MMVIII |
|||
1666 in roman is MDCLXVI |
|||
</pre> |
|||
And the reverse: |
|||
<syntaxhighlight lang="actionscript">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"));</syntaxhighlight> |
|||
{{out}} |
|||
<pre>MCMXC in arabic is 1990 |
|||
MMVIII in arabic is 2008 |
|||
MDCLXVI in arabic is 1666</pre> |
|||
=={{header|Ada}}== |
=={{header|Ada}}== |
||
<syntaxhighlight lang="ada">with Ada.Text_IO; use Ada.Text_IO; |
|||
<lang ada> |
|||
with Ada.Text_IO; use Ada.Text_IO; |
|||
procedure Roman_Numeral_Test is |
procedure Roman_Numeral_Test is |
||
Line 38: | Line 564: | ||
Put_Line (To_Roman (25)); |
Put_Line (To_Roman (25)); |
||
Put_Line (To_Roman (944)); |
Put_Line (To_Roman (944)); |
||
end Roman_Numeral_Test; |
end Roman_Numeral_Test;</syntaxhighlight> |
||
{{out}} |
|||
</lang> |
|||
<pre> |
|||
Output: |
|||
MCMXCIX |
MCMXCIX |
||
XXV |
XXV |
||
CMXLIV |
CMXLIV |
||
</pre> |
|||
=={{header|ALGOL 68}}== |
=={{header|ALGOL 68}}== |
||
{{works with|ALGOL 68| |
{{works with|ALGOL 68|Revision 1 - no extensions to language used}} |
||
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}} |
|||
{{works with| |
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}} |
||
<lang algol> |
|||
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d]}} |
|||
[]CHAR roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands # |
|||
<syntaxhighlight lang="algol68">[]CHAR roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands # |
|||
[]CHAR adjust roman = "CCXXmmccxxii"; |
[]CHAR adjust roman = "CCXXmmccxxii"; |
||
[]INT arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1); |
[]INT arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1); |
||
Line 78: | Line 606: | ||
print((val, " - ", arabic to roman(val), new line)) |
print((val, " - ", arabic to roman(val), new line)) |
||
OD |
OD |
||
)</ |
)</syntaxhighlight> |
||
{{out}} (last example is manually wrapped): |
|||
Output: |
|||
<pre style="height:30ex;overflow:scroll"> |
|||
<pre> |
|||
+1 - i |
+1 - i |
||
+2 - ii |
+2 - ii |
||
Line 141: | Line 669: | ||
+500000 - D |
+500000 - D |
||
+1000000 - M |
+1000000 - M |
||
+2147483647 - MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM |
|||
+2147483647 - MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMCDLXXXmmmdcxlvii |
|||
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</pre> |
|||
=={{header|ALGOL W}}== |
|||
<!-- {{works with|ALGOL W|Standard - no extensions to language used}} --> |
|||
{{works with|awtoc|any - tested with release [http://www.jampan.co.nz/~glyn/aw2c.tar.gz Mon Apr 27 14:25:27 NZST 2009]}} |
|||
<!-- This specimen was emailed to be by Glyn Webster > "Here's a Roman number procedure that would fit in:" --> |
|||
<syntaxhighlight lang="algolw">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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
I 1 |
|||
MMMCMXCIX 9 |
|||
MMMDCCCLXXXVIII 15 |
|||
MMIX 4 |
|||
CDV 3 |
|||
</pre> |
</pre> |
||
=={{header|APL}}== |
|||
{{works with|Dyalog APL}} |
|||
<syntaxhighlight lang="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 |
|||
}⍵ |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> toRoman¨ 1990 2008 1666 2021 |
|||
MCMXC MMVIII MDCLXVI MMXXI </pre> |
|||
=={{header|AppleScript}}== |
|||
{{Trans|JavaScript}} |
|||
(ES6 version) |
|||
{{Trans|Haskell}} |
|||
(mapAccumL version) |
|||
<syntaxhighlight lang="applescript">------------------ 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]} |
|||
script stringAddedValueDeducted |
|||
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 |
|||
concat(snd(mapAccumL(stringAddedValueDeducted, n, kvs))) |
|||
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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>{"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}</pre> |
|||
=={{header|Arturo}}== |
|||
{{trans|Nim}} |
|||
<syntaxhighlight lang="rebol">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]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|AutoHotkey}}== |
=={{header|AutoHotkey}}== |
||
{{trans|C++}} |
|||
Translated from C++ example |
|||
<syntaxhighlight lang="autohotkey">MsgBox % stor(444) |
|||
<lang AutoHotkey> |
|||
MsgBox % stor(444) |
|||
stor(value) |
stor(value) |
||
Line 173: | Line 1,046: | ||
} |
} |
||
Return result . "O" |
Return result . "O" |
||
}</syntaxhighlight> |
|||
} |
|||
</lang> |
|||
=={{header|Autolisp}}== |
|||
<syntaxhighlight lang="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 |
|||
) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1577 "MDLXXVII" |
|||
3999 "MMMCMXCIX" |
|||
888 "DCCCLXXXVIII" |
|||
159 "CLIX" |
|||
</pre> |
|||
=={{header|AWK}}== |
=={{header|AWK}}== |
||
<syntaxhighlight lang="awk"> |
|||
{{trans|Tcl}} |
|||
# 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]) |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 = MCMXC |
|||
2008 = MMVIII |
|||
1666 = MDCLXVI |
|||
</pre> |
|||
=={{header|BASIC}}== |
|||
==={{header|Applesoft BASIC}}=== |
|||
<syntaxhighlight lang="gwbasic"> 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</syntaxhighlight> |
|||
==={{header|ASIC}}=== |
|||
{{trans|DWScript}} |
|||
<syntaxhighlight lang="basic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
==={{header|BaCon}}=== |
|||
<syntaxhighlight lang="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) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMVIII |
|||
MDCLXVI |
|||
</pre> |
|||
==={{header|BASIC256}}=== |
|||
{{works with|BASIC256 }} |
|||
<syntaxhighlight lang="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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1666 = MDCLXVI |
|||
2008 = MMVIII |
|||
1001 = MI |
|||
1999 = MCMXCIX |
|||
</pre> |
|||
==={{header|BBC BASIC}}=== |
|||
<syntaxhighlight lang="bbcbasic"> 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$</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1999 MCMXCIX |
|||
2012 MMXII |
|||
1666 MDCLXVI |
|||
3888 MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|Chipmunk Basic}}=== |
|||
{{works with|Chipmunk Basic|3.6.4}} |
|||
{{trans|GW-BASIC}} |
|||
<syntaxhighlight lang="qbasic">100 cls |
|||
110 dim arabic(12), roman$(12) |
|||
120 for j = 0 to 12 : read arabic(j),roman$(j) : next j |
|||
130 data 1000,"M", 900,"CM", 500,"D", 400,"CD", 100,"C", 90,"XC" |
|||
140 data 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I" |
|||
187 avalor = 1990 : print avalor "= "; : gosub 220 : print roman$ ' MCMXC |
|||
188 avalor = 2008 : print avalor "= "; : gosub 220 : print roman$ ' MMXXII |
|||
189 avalor = 1666 : print avalor "= "; : gosub 220 : print roman$ ' MDCLXVI |
|||
200 end |
|||
210 rem Encode to Roman |
|||
220 roman$ = "" : i = 0 |
|||
230 while (i <= 12) and (avalor > 0) |
|||
240 while avalor >= arabic(i) |
|||
250 roman$ = roman$+roman$(i) |
|||
260 avalor = avalor-arabic(i) |
|||
270 wend |
|||
280 i = i+1 |
|||
290 wend |
|||
300 return</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990 = MCMXC |
|||
2008 = MMVIII |
|||
1666 = MDCLXVI</pre> |
|||
==={{header|Commodore BASIC}}=== |
|||
{{works with|Commodore BASIC|7.0}} |
|||
C-128 version: |
|||
<syntaxhighlight lang="basic">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</syntaxhighlight> |
|||
{{works with|Commodore BASIC|3.5}} |
|||
C-16/116/Plus-4 version (BASIC 3.5 has DO/LOOP but not BEGIN/BEND) |
|||
<syntaxhighlight lang="basic">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</syntaxhighlight> |
|||
{{works with|Commodore BASIC|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. |
|||
<syntaxhighlight lang="basic">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 |
|||
</syntaxhighlight> |
|||
The output is the same for all the above versions: |
|||
{{Out}} |
|||
<pre>***** ROMAN NUMERAL ENCODER ***** |
|||
ENTER NUMBER (0 TO QUIT):2009 |
|||
To cram this into an AWK one-liner is a bit of a stretch, but here goes: |
|||
<lang awk> |
|||
$ awk 'func u(v,n){while(i>=v){r=r n;i-=v}}{i=$1;r="";u(1000,"M");u(900,"CM");u(500,"D");u(400,"CD");u(100,"C");u(90,"XC");u(50,"L");u(40,"XL");u(10,"X");u(9,"IX");u(5,"V");u(4,"IV");u(1,"I");print r}' |
|||
2009 |
|||
MMIX |
MMIX |
||
1999 |
|||
MCMXCIX |
|||
</lang> |
|||
ENTER NUMBER (0 TO QUIT):1666 |
|||
=={{header|BASIC}}== |
|||
MDCLXVI |
|||
ENTER NUMBER (0 TO QUIT):3888 |
|||
MMMDCCCLXXXVIII |
|||
ENTER NUMBER (0 TO QUIT):0 |
|||
READY.</pre> |
|||
==={{header|FreeBASIC}}=== |
|||
{{works with|FreeBASIC}} |
{{works with|FreeBASIC}} |
||
< |
<syntaxhighlight lang="freebasic"> |
||
DIM SHARED arabic(0 TO 12) AS Integer => {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 } |
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"} |
DIM SHARED roman(0 TO 12) AS String*2 => {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"} |
||
Line 211: | Line 1,416: | ||
PRINT "1666 = "; toRoman(1666) |
PRINT "1666 = "; toRoman(1666) |
||
PRINT "3888 = "; toRoman(3888) |
PRINT "3888 = "; toRoman(3888) |
||
</syntaxhighlight> |
|||
</lang> |
|||
{{out}} |
|||
Output |
|||
<pre> |
|||
2009 = MMIX |
2009 = MMIX |
||
1666 = MDCLXVI |
1666 = MDCLXVI |
||
3888 = MMMDCCCLXXXVIII |
3888 = MMMDCCCLXXXVIII |
||
</pre> |
|||
Another solution: |
|||
<syntaxhighlight lang="freebasic">' 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 => MCMXC |
|||
2008 => MMVIII |
|||
1666 => MDCLXVI |
|||
</pre> |
|||
==={{header|FutureBasic}}=== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
Output: |
|||
<pre> |
|||
1990 = MCMXC |
|||
2008 = MMVIII |
|||
2016 = MMXVI |
|||
1666 = MDCLXVI |
|||
3888 = MMMDCCCLXXXVIII |
|||
1914 = MCMXIV |
|||
1000 = M |
|||
513 = DXIII |
|||
33 = XXXIII |
|||
</pre> |
|||
==={{header|Gambas}}=== |
|||
{{trans|FreeBASIC}} |
|||
<syntaxhighlight lang="vbnet">Public Sub Main() |
|||
'Testing |
|||
Print "2009 = "; toRoman(2009) |
|||
Print "1666 = "; toRoman(1666) |
|||
Print "3888 = "; toRoman(3888) |
|||
End |
|||
Function toRoman(value As Integer) As String |
|||
Dim result As String |
|||
Dim arabic As Integer[] = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1] |
|||
Dim roman As String[] = ["M", "CM", "D", "CD", "C", "XC", "L" , "XL", "X", "IX", "V", "IV", "I"] |
|||
For i As Integer = 0 To arabic.Max |
|||
Do While value >= arabic[i] |
|||
result &= roman[i] |
|||
value -= arabic[i] |
|||
Loop |
|||
Next |
|||
Return result |
|||
End Function</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Same as FreeBASIC entry.</pre> |
|||
=== {{header|GW-BASIC}} === |
|||
{{trans|DWScript}} |
|||
{{works with|BASICA}} |
|||
<syntaxhighlight lang="gwbasic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXXII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|IS-BASIC}}=== |
|||
<syntaxhighlight lang="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"</syntaxhighlight> |
|||
==={{header|Liberty BASIC}}=== |
|||
{{works with|Just BASIC}} |
|||
<syntaxhighlight lang="lb"> |
|||
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 |
|||
</syntaxhighlight> |
|||
<pre> |
|||
2009 MMIX |
|||
1666 MDCLXVI |
|||
3888 MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|Microsoft Small Basic}}=== |
|||
{{trans|DWScript}} |
|||
<syntaxhighlight lang="microsoftsmallbasic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXVIII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|Nascom BASIC}}=== |
|||
{{trans|DWScript}} |
|||
{{works with|Nascom ROM BASIC|4.7}} |
|||
<syntaxhighlight lang="basic"> |
|||
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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXXII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|PowerBASIC}}=== |
|||
{{trans|BASIC}} |
|||
{{works with|PB/Win|8+}} |
|||
{{works with|PB/CC|5}} |
|||
<syntaxhighlight lang="powerbasic">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</syntaxhighlight> |
|||
==={{header|PureBasic}}=== |
|||
<syntaxhighlight lang="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 |
|||
Read.s refRomanNum(i)\symbol |
|||
Next |
|||
Restore denomValues |
|||
For i = 0 To #SymbolCount |
|||
Read refRomanNum(i)\value |
|||
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</syntaxhighlight> |
|||
==={{header|QBasic}}=== |
|||
<syntaxhighlight lang="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)</syntaxhighlight> |
|||
==={{header|Run BASIC}}=== |
|||
<syntaxhighlight lang="runbasic">[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</syntaxhighlight> |
|||
==={{header|TI-83 BASIC}}=== |
|||
<syntaxhighlight lang="ti83b">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 |
|||
</syntaxhighlight> |
|||
==={{header|True BASIC}}=== |
|||
<syntaxhighlight lang="qbasic">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</syntaxhighlight> |
|||
==={{header|uBasic/4tH}}=== |
|||
{{trans|BBC Basic}} |
|||
<syntaxhighlight lang="text">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</syntaxhighlight> |
|||
==={{header|Visual Basic}}=== |
|||
{{trans|BASIC}} |
|||
<syntaxhighlight lang="vb">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</syntaxhighlight> |
|||
==={{header|XBasic}}=== |
|||
{{trans|DWScript}} |
|||
{{works with|Windows XBasic}} |
|||
<syntaxhighlight lang="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 |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXVIII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
==={{header|Yabasic}}=== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
==={{header|ZX Spectrum Basic}}=== |
|||
<syntaxhighlight lang="zxbasic"> 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$</syntaxhighlight> |
|||
=={{header|Batch File}}== |
|||
{{trans|BASIC}} |
|||
<syntaxhighlight lang="dos">@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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>2009 = MMIX |
|||
1666 = MDCLXVI |
|||
3888 = MMMDCCCLXXXVIII</pre> |
|||
=={{header|BCPL}}== |
|||
<syntaxhighlight lang="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) |
|||
$)</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1666 = MDCLXVI |
|||
2008 = MMVIII |
|||
1001 = MI |
|||
1999 = MCMXCIX |
|||
3888 = MMMDCCCLXXXVIII |
|||
2021 = MMXXI</pre> |
|||
=={{header|Befunge}}== |
|||
Reads the number to convert from standard input. No range validation is performed. |
|||
<syntaxhighlight lang="befunge">&>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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1666 |
|||
MDCLXVI</pre> |
|||
=={{header|BQN}}== |
|||
{{trans|APL}} |
|||
<syntaxhighlight lang="bqn">⟨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⍋𝕩 |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out|Example use}} |
|||
<syntaxhighlight lang="text"> ToRoman¨ 1990‿2008‿1666‿2021 |
|||
⟨ "MCMXC" "MMVIII" "MDCLXVI" "MMXXI" ⟩</syntaxhighlight> |
|||
=={{header|Bracmat}}== |
|||
<syntaxhighlight lang="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") |
|||
) |
|||
) |
|||
);</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990 MCMXC |
|||
2008 MMVIII |
|||
1666 MDCLXVI |
|||
3888 MMMDCCCLXXXVIII |
|||
3999 MMMCMXCIX |
|||
Can't convert 4000 to Roman numeral</pre> |
|||
=={{header|C}}== |
=={{header|C}}== |
||
===Naive solution=== |
|||
This solution is a smart but does not return the number written as a string. |
|||
<syntaxhighlight lang="c">#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; |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>Enter arabic number: |
|||
215 |
|||
Roman number: |
|||
CCXV |
|||
</pre> |
|||
===Not thread-safe=== |
|||
<syntaxhighlight lang="c">#define _CRT_SECURE_NO_WARNINGS |
|||
<lang c>#include <stdlib.h> |
|||
#include <stdio.h> |
#include <stdio.h> |
||
#include <string.h> |
|||
int RomanNumerals_parseInt(const char* string) |
|||
void roman(char *s, unsigned n) |
|||
{ |
|||
/* Writes the Roman numeral representing n into the buffer s. |
|||
int value; |
|||
Handles up to n = 3999. Since C doesn't have exceptions, n = 0 |
|||
return scanf("%u", &value) == 1 && value > 0 ? value : 0; |
|||
causes the whole program to exit unsuccessfully. s should be |
|||
} |
|||
have room for at least 16 characters, including the trailing |
|||
null. */ |
|||
{if (n == 0) |
|||
{puts("Roman numeral for zero requested."); |
|||
exit(EXIT_FAILURE);} |
|||
const char* RomanNumerals_toString(int value) |
|||
#define digit(loop, num, c) \ |
|||
{ |
|||
loop (n >= num) \ |
|||
#define ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE 64 |
|||
{*(s++) = c; \ |
|||
static buffer[ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE]; |
|||
n -= num;} |
|||
#define digits(loop, num, c1, c2) \ |
|||
loop (n >= num) \ |
|||
{*(s++) = c1; \ |
|||
*(s++) = c2; \ |
|||
n -= num;} |
|||
const static int maxValue = 5000; |
|||
const static int minValue = 1; |
|||
digits ( if, 900, 'C', 'M' ) |
|||
digit ( if, 500, 'D' ) |
|||
digits ( if, 400, 'C', 'D' ) |
|||
digit ( while, 100, 'C' ) |
|||
digits ( if, 90, 'X', 'C' ) |
|||
digit ( if, 50, 'L' ) |
|||
digits ( if, 40, 'X', 'L' ) |
|||
digit ( while, 10, 'X' ) |
|||
digits ( if, 9, 'I', 'X' ) |
|||
digit ( if, 5, 'V' ) |
|||
digits ( if, 4, 'I', 'V' ) |
|||
digit ( while, 1, 'I' ) |
|||
const static struct Digit { |
|||
#undef digit |
|||
char string[4]; // It's better to use 4 than 3 (aligment). |
|||
#undef digits |
|||
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)); |
|||
int main(void) |
|||
if (minValue <= value && value <= maxValue) |
|||
{char buffer[16]; |
|||
{ |
|||
for (int i = 1 ; i < 4000 ; ++i) |
|||
struct Digit* digit = &digits[0]; |
|||
{roman(buffer, i); |
|||
printf("%4d: %s\n", i, buffer);} |
|||
return 1;}</lang> |
|||
while (digit->value) |
|||
An alternative version which builds the string backwards. <lang c>char *ToRoman(int num, char *buf, int buflen) |
|||
{ |
|||
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) |
|||
static const char *romanDgts = "ivxlcdmVXLCDM_"; |
|||
{ |
|||
char *roman = buf + buflen; |
|||
// Blanks are needed for a consistient blackground on some systems. |
|||
int rdix, r, v; |
|||
// BTW, puts append an extra newline at the end. |
|||
*--roman = '\0'; /* null terminate return string */ |
|||
// |
|||
puts("Write given numbers as Roman numerals. \n" |
|||
" \n" |
|||
return NULL; |
|||
"Usage: \n" |
|||
} |
|||
" roman n1 n2 n3 ... \n" |
|||
for (rdix = 0; rdix < strlen(romanDgts); rdix += 2) { |
|||
" \n" |
|||
if (num == 0) break; |
|||
"where n1 n2 n3 etc. are Arabic numerals\n"); |
|||
v = (num % 10) / 5; |
|||
r = num % 5; |
|||
int numbers[] = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1498, 2022 }; |
|||
num = num / 10; |
|||
for (int i = 0; i < sizeof(numbers) / sizeof(int); i++) |
|||
{ |
|||
printf(" |
printf("%4d = %s\n", |
||
numbers[i], RomanNumerals_toString(numbers[i])); |
|||
return NULL; |
|||
} |
|||
} |
|||
else |
|||
{ |
|||
for (int i = 1; i < argc; i++) |
|||
{ |
|||
int number = RomanNumerals_parseInt(argv[i]); |
|||
if (number) |
|||
{ |
|||
puts(RomanNumerals_toString(number)); |
|||
} |
} |
||
else |
|||
{ |
|||
puts("???"); |
|||
else { |
|||
if (roman < buf+r+v) { |
|||
printf("Buffer too small."); |
|||
return NULL; |
|||
} |
} |
||
} |
|||
} |
|||
*--roman = romanDgts[rdix]; |
|||
return 0; |
|||
}</syntaxhighlight> |
|||
{{Output}} |
|||
<pre>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</pre> |
|||
=={{header|C sharp|C#}}== |
|||
<syntaxhighlight lang="csharp">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) |
|||
}</lang> |
|||
{ |
|||
Console.WriteLine("{0} = {1}", number, ToRoman(number)); |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
One-liner Mono REPL |
|||
<syntaxhighlight lang="csharp"> |
|||
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)); |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1 = I |
|||
2 = II |
|||
4 = IV |
|||
8 = VIII |
|||
16 = XVI |
|||
32 = XXXII |
|||
64 = LXIV |
|||
128 = CXXVIII |
|||
256 = CCLVI |
|||
512 = DXII |
|||
1024 = MXXIV |
|||
</pre> |
|||
=={{header|C++}}== |
=={{header|C++}}== |
||
===C++ 98=== |
|||
<lang cpp> |
|||
#include <iostream> |
<syntaxhighlight lang="cpp">#include <iostream> |
||
#include <string> |
#include <string> |
||
Line 330: | Line 2,596: | ||
4, "IV", |
4, "IV", |
||
1, "I", |
1, "I", |
||
0, |
0, NULL }; // end marker |
||
std::string result; |
std::string result; |
||
Line 350: | Line 2,616: | ||
std::cout << to_roman(i) << std::endl; |
std::cout << to_roman(i) << std::endl; |
||
} |
} |
||
}</syntaxhighlight> |
|||
===C++ 11=== |
|||
<syntaxhighlight lang="cpp">#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); |
|||
} |
} |
||
</lang> |
|||
int main() { |
|||
for (int i = 0; i < 2018; i++) |
|||
std::cout << i << " --> " << to_roman(i) << std::endl; |
|||
}</syntaxhighlight> |
|||
=={{header|Ceylon}}== |
|||
<syntaxhighlight lang="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.char````bigNum.char``"; |
|||
value twoCharValue = bigNum.int - smallNum.int; |
|||
return "``twoCharSymbol````toRoman(hindu - twoCharValue, tierIndex)``"; |
|||
} |
|||
else if (exists num = tier.reversed.find((Numeral elem) => hindu >= elem.int)) { |
|||
return "``num.char````toRoman(hindu - num.int, tierIndex)``"; |
|||
} |
|||
else { |
|||
// nothing was found so move to the next smaller tier! |
|||
return toRoman(hindu, tierIndex - 1); |
|||
} |
|||
} |
|||
assert (toRoman(1) == "I"); |
|||
assert (toRoman(2) == "II"); |
|||
assert (toRoman(4) == "IV"); |
|||
assert (toRoman(1666) == "MDCLXVI"); |
|||
assert (toRoman(1990) == "MCMXC"); |
|||
assert (toRoman(2008) == "MMVIII"); |
|||
}</syntaxhighlight> |
|||
=={{header|Clojure}}== |
|||
The easiest way is to use the built-in cl-format function |
|||
<syntaxhighlight lang="clojure">(def arabic->roman |
|||
(partial clojure.pprint/cl-format nil "~@R")) |
|||
(arabic->roman 147) |
|||
;"CXXIII" |
|||
(arabic->roman 99) |
|||
;"XCIX"</syntaxhighlight>Alternatively:<syntaxhighlight lang="clojure">(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"</syntaxhighlight> |
|||
An alternate implementation: |
|||
<syntaxhighlight lang="clojure"> |
|||
(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))))))))) |
|||
</syntaxhighlight> |
|||
Usage: |
|||
<syntaxhighlight lang="clojure"> |
|||
(a2r 1666) |
|||
"MDCLXVI" |
|||
(map a2r [1000 1 389 45]) |
|||
("M" "I" "CCCLXXXIX" "XLV") |
|||
</syntaxhighlight> |
|||
An alternate implementation: |
|||
<syntaxhighlight lang="clojure"> |
|||
(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)))))))) |
|||
</syntaxhighlight> |
|||
Usage: |
|||
<syntaxhighlight lang="clojure"> |
|||
(a2r 1666) |
|||
"MDCLXVI" |
|||
(map a2r [1000 1 389 45]) |
|||
("M" "I" "CCCLXXXIX" "XLV") |
|||
</syntaxhighlight> |
|||
=={{header|CLU}}== |
|||
<syntaxhighlight lang="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 |
|||
stream$putl(po, int$unparse(test) || " = " || roman$encode(test)) |
|||
end |
|||
end start_up</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1666 = MDCLXVI |
|||
2008 = MMVIII |
|||
1001 = MI |
|||
1999 = MCMXCIX |
|||
3888 = MMMDCCCLXXXVIII |
|||
2021 = MMXXI</pre> |
|||
=={{header|COBOL}}== |
|||
<syntaxhighlight lang="cobol"> |
|||
IDENTIFICATION DIVISION. |
|||
PROGRAM-ID. TOROMAN. |
|||
DATA DIVISION. |
|||
working-storage section. |
|||
01 ws-number pic 9(4) value 0. |
|||
01 ws-save-number pic 9(4). |
|||
01 ws-tbl-def. |
|||
03 filler pic x(7) value '1000M '. |
|||
03 filler pic x(7) value '0900CM '. |
|||
03 filler pic x(7) value '0500D '. |
|||
03 filler pic x(7) value '0400CD '. |
|||
03 filler pic x(7) value '0100C '. |
|||
03 filler pic x(7) value '0090XC '. |
|||
03 filler pic x(7) value '0050L '. |
|||
03 filler pic x(7) value '0040XL '. |
|||
03 filler pic x(7) value '0010X '. |
|||
03 filler pic x(7) value '0009IX '. |
|||
03 filler pic x(7) value '0005V '. |
|||
03 filler pic x(7) value '0004IV '. |
|||
03 filler pic x(7) value '0001I '. |
|||
01 filler redefines ws-tbl-def. |
|||
03 filler occurs 13 times indexed by rx. |
|||
05 ws-tbl-divisor pic 9(4). |
|||
05 ws-tbl-roman-ch pic x(1) occurs 3 times indexed by cx. |
|||
01 ocx pic 99. |
|||
01 ws-roman. |
|||
03 ws-roman-ch pic x(1) occurs 16 times. |
|||
PROCEDURE DIVISION. |
|||
accept ws-number |
|||
perform |
|||
until ws-number = 0 |
|||
move ws-number to ws-save-number |
|||
if ws-number > 0 and ws-number < 4000 |
|||
initialize ws-roman |
|||
move 0 to ocx |
|||
perform varying rx from 1 by +1 |
|||
until ws-number = 0 |
|||
perform until ws-number < ws-tbl-divisor (rx) |
|||
perform varying cx from 1 by +1 |
|||
until ws-tbl-roman-ch (rx, cx) = spaces |
|||
compute ocx = ocx + 1 |
|||
move ws-tbl-roman-ch (rx, cx) to ws-roman-ch (ocx) |
|||
end-perform |
|||
compute ws-number = ws-number - ws-tbl-divisor (rx) |
|||
end-perform |
|||
end-perform |
|||
display 'inp=' ws-save-number ' roman=' ws-roman |
|||
else |
|||
display 'inp=' ws-save-number ' invalid' |
|||
end-if |
|||
accept ws-number |
|||
end-perform |
|||
. |
|||
</syntaxhighlight> |
|||
{{out}} (input was supplied via STDIN) |
|||
<pre> |
|||
inp=0111 roman=CXI |
|||
inp=2234 roman=MMCCXXXIV |
|||
inp=0501 roman=DI |
|||
inp=0010 roman=X |
|||
inp=0040 roman=XL |
|||
inp=0050 roman=L |
|||
inp=0066 roman=LXVI |
|||
inp=0666 roman=DCLXVI |
|||
inp=5666 invalid |
|||
inp=3333 roman=MMMCCCXXXIII |
|||
inp=3888 roman=MMMDCCCLXXXVIII |
|||
inp=3999 roman=MMMCMXCIX |
|||
inp=3345 roman=MMMCCCXLV |
|||
</pre> |
|||
=={{header|CoffeeScript}}== |
|||
<syntaxhighlight lang="coffeescript"> |
|||
decimal_to_roman = (n) -> |
|||
# This should work for any positive integer, although it |
|||
# gets a bit preposterous for large numbers. |
|||
if n >= 4000 |
|||
thousands = decimal_to_roman n / 1000 |
|||
ones = decimal_to_roman n % 1000 |
|||
return "M(#{thousands})#{ones}" |
|||
s = '' |
|||
translate_each = (min, roman) -> |
|||
while n >= min |
|||
n -= min |
|||
s += roman |
|||
translate_each 1000, "M" |
|||
translate_each 900, "CM" |
|||
translate_each 500, "D" |
|||
translate_each 400, "CD" |
|||
translate_each 100, "C" |
|||
translate_each 90, "XC" |
|||
translate_each 50, "L" |
|||
translate_each 40, "XL" |
|||
translate_each 10, "X" |
|||
translate_each 9, "IX" |
|||
translate_each 5, "V" |
|||
translate_each 4, "IV" |
|||
translate_each 1, "I" |
|||
s |
|||
################### |
|||
tests = |
|||
IV: 4 |
|||
XLII: 42 |
|||
MCMXC: 1990 |
|||
MMVIII: 2008 |
|||
MDCLXVI: 1666 |
|||
'M(IV)': 4000 |
|||
'M(VI)IX': 6009 |
|||
'M(M(CXXIII)CDLVI)DCCLXXXIX': 123456789 |
|||
'M(MMMV)I': 3005001 |
|||
for expected, decimal of tests |
|||
roman = decimal_to_roman(decimal) |
|||
if roman == expected |
|||
console.log "#{decimal} = #{roman}" |
|||
else |
|||
console.log "error for #{decimal}: #{roman} is wrong" |
|||
</syntaxhighlight> |
|||
=={{header|Common Lisp}}== |
=={{header|Common Lisp}}== |
||
<syntaxhighlight lang="lisp">(defun roman-numeral (n) |
|||
(format nil "~@R" n))</syntaxhighlight> |
|||
=={{header| |
=={{header|Cowgol}}== |
||
<syntaxhighlight lang="cowgol">include "cowgol.coh"; |
|||
This implementation in generally follows the rules implied by [[wp:Roman_numerals#Modern_Roman_numerals|Modern Roman numerals]], with some irregularity depend on whether numerals larger than '''M'''(1000) is used, eg. 4000 is converted to '''MV'''' if '''V'''' is used, '''MMMM''' if not. |
|||
include "argv.coh"; |
|||
<lang d>module roman ; |
|||
import std.stdio ; |
|||
# Encode the given number as a Roman numeral |
|||
const string[] Roman = ["V","X","L","C","D","M","I"] ; |
|||
sub decimalToRoman(num: uint16, buf: [uint8]): (rslt: [uint8]) is |
|||
const int RLen = Roman.length - 1 ; |
|||
# return the start of the buffer for easy printing |
|||
const int[][] RDigit = |
|||
rslt := buf; |
|||
[[0],[0,0],[0,0,0],[0,1],[1],[1,0],[1,0,0],[1,0,0,0],[0,2],[0,0,0,0]] ; |
|||
const string[] Power = ["", "'","\"","`","~","^","#"] ; // arbitary _power_ symbols, or |
|||
# Add string to buffer |
|||
// Power = ["1","2","3","4","5","6","7"] ; // for easier further processing |
|||
sub Add(str: [uint8]) is |
|||
const int[][] Shift = [[0,0,0],[-1,0,0]] ; |
|||
while [str] != 0 loop |
|||
[buf] := [str]; |
|||
buf := @next buf; |
|||
str := @next str; |
|||
end loop; |
|||
end sub; |
|||
# Table of Roman numerals |
|||
record Roman is |
|||
value: uint16; |
|||
string: [uint8]; |
|||
end record; |
|||
var numerals: Roman[] := { |
|||
{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"} |
|||
}; |
|||
var curNum := &numerals as [Roman]; |
|||
while num != 0 loop |
|||
while num >= curNum.value loop |
|||
Add(curNum.string); |
|||
num := num - curNum.value; |
|||
end loop; |
|||
curNum := @next curNum; |
|||
end loop; |
|||
[buf] := 0; # terminate the string |
|||
end sub; |
|||
# Read numbers from the command line and print the corresponding Roman numerals |
|||
string romanPart(int n, int part, bool extented) { |
|||
ArgvInit(); |
|||
if (n == 0) return "" ; |
|||
var buffer: uint8[100]; |
|||
int[3] b ; |
|||
loop |
|||
b[1] = (2 * part) % RLen ; |
|||
var argmt := ArgvNext(); |
|||
b[0] = part == 0 ? RLen : (RLen + b[1] - 1) % RLen ; |
|||
if argmt == (0 as [uint8]) then |
|||
break; |
|||
end if; |
|||
int[] shift = Shift[ b[1] == 0 && part != 0 ? 1 : 0] ; |
|||
int[] Digit = !extented && n == 4 && part == 3 ? RDigit[$-1] : RDigit[n-1] ; |
|||
var dummy: [uint8]; |
|||
string res ; |
|||
var number: int32; |
|||
foreach(inx ; Digit) |
|||
(number, dummy) := AToI(argmt); |
|||
res ~= Roman[b[inx]] ~ Power[power + shift[inx]] ; |
|||
print(decimalToRoman(number as uint16, &buffer as [uint8])); |
|||
print_nl(); |
|||
end loop;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>$ ./romanenc.386 1990 2008 1666 |
|||
MCMXC |
|||
MMVIII |
|||
MDCLXVI</pre> |
|||
=={{header|D}}== |
|||
<syntaxhighlight lang="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"); |
|||
} |
} |
||
string toRoman(long n, bool extented = true) { |
|||
if(n < 0) throw new Exception("No negative Roman Numeral") ; |
|||
if(n == 0) return "" ; |
|||
if(!extented && n >= 5000) throw new Exception("Only smaller than 5000 allowed") ; |
|||
string romans ; |
|||
int part = 0 ; |
|||
while (n > 0) { |
|||
long m = n / 10 ; |
|||
romans = romanPart(n - m*10, part, extented) ~ romans ; |
|||
n = m ; |
|||
part++ ; |
|||
} |
|||
return romans ; |
|||
} |
|||
void main() { |
|||
auto test = [1L,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,long.max] ; |
|||
foreach(x ; test) |
|||
writefln("%20s - %s", x, toRoman(x)) ; |
|||
}</lang> |
|||
void main() {}</syntaxhighlight> |
|||
=={{header|Factor}}== |
|||
A roman numeral library ships with Factor. |
|||
USE: roman |
|||
( scratchpad ) 3333 >roman . |
|||
"mmmcccxxxiii" |
|||
=={{header|Delphi}}== |
|||
: roman-digits ( -- seq ) |
|||
{{trans|DWScript}} |
|||
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" } ; |
|||
<syntaxhighlight lang="delphi">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.</syntaxhighlight> |
|||
=={{header|DWScript}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="delphi">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));</syntaxhighlight> |
|||
=={{header|EasyLang}}== |
|||
<syntaxhighlight lang="text"> |
|||
func$ dec2rom dec . |
|||
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" ] |
|||
for i = 1 to len values[] |
|||
while dec >= values[i] |
|||
rom$ &= symbol$[i] |
|||
dec -= values[i] |
|||
. |
|||
. |
|||
return rom$ |
|||
. |
|||
print dec2rom 1990 |
|||
print dec2rom 2008 |
|||
print dec2rom 1666 |
|||
</syntaxhighlight> |
|||
=={{header|ECL}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
=={{header|Ed}}== |
|||
<syntaxhighlight> |
|||
H |
|||
g/0([0-9]{3})/s//\1/ |
|||
g/1([0-9]{3})/s//M\1/ |
|||
g/2([0-9]{3})/s//MM\1/ |
|||
g/3([0-9]{3})/s//MMM\1/ |
|||
g/4([0-9]{3})/s//MMMM\1/ |
|||
g/0([0-9]{2})/s//\1/ |
|||
g/1([0-9]{2})/s//C\1/ |
|||
g/2([0-9]{2})/s//CC\1/ |
|||
g/3([0-9]{2})/s//CCC\1/ |
|||
g/4([0-9]{2})/s//CD\1/ |
|||
g/5([0-9]{2})/s//D\1/ |
|||
g/6([0-9]{2})/s//DC\1/ |
|||
g/7([0-9]{2})/s//DCC\1/ |
|||
g/8([0-9]{2})/s//DCCC\1/ |
|||
g/9([0-9]{2})/s//CM\1/ |
|||
g/0([0-9]{2})/s//\1/ |
|||
g/1([0-9]{1})/s//X\1/ |
|||
g/2([0-9]{1})/s//XX\1/ |
|||
g/3([0-9]{1})/s//XXX\1/ |
|||
g/4([0-9]{1})/s//XL\1/ |
|||
g/5([0-9]{1})/s//L\1/ |
|||
g/6([0-9]{1})/s//LX\1/ |
|||
g/7([0-9]{1})/s//LXX\1/ |
|||
g/8([0-9]{1})/s//LXXX\1/ |
|||
g/9([0-9]{1})/s//XC\1/ |
|||
g/0([0-9]{1})/s//\1/ |
|||
g/1/s//I/ |
|||
g/2/s//II/ |
|||
g/3/s//III/ |
|||
g/4/s//IV/ |
|||
g/5/s//V/ |
|||
g/6/s//VI/ |
|||
g/7/s//VII/ |
|||
g/8/s//VIII/ |
|||
g/9/s//IX/ |
|||
g/0/s/// |
|||
,p |
|||
Q |
|||
</syntaxhighlight> |
|||
=={{header|Eiffel}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
=={{header|Ela}}== |
|||
{{trans|Haskell}} |
|||
<syntaxhighlight lang="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 = "" |
|||
: roman-values ( -- seq ) |
|||
toRoman x | x < 0 = fail "Negative roman numeral" |
|||
{ 1000 900 500 400 100 90 50 40 10 9 5 4 1 } ; |
|||
| 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]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>["MCMXCIX","XXV","CMXLIV"]</pre> |
|||
=={{header|Elena}}== |
|||
{{trans|C#}} |
|||
ELENA 6.x : |
|||
<syntaxhighlight lang="elena">import system'collections; |
|||
import system'routines; |
|||
import extensions; |
|||
import extensions'text; |
|||
static RomanDictionary = Dictionary.new() |
|||
ERROR: roman-range-error n ; |
|||
.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 |
|||
: roman-range-check ( n -- ) |
|||
{ |
|||
dup 1 3999 between? [ drop ] [ roman-range-error ] if ; |
|||
toRoman() |
|||
= RomanDictionary.accumulate(new StringWriter("I", self), (m,kv => m.replace(new StringWriter("I",kv.Key).Value, kv.Value))); |
|||
} |
|||
public program() |
|||
: (>roman) ( n -- ) |
|||
{ |
|||
roman-values roman-digits [ |
|||
console.printLine("1990 : ", 1990.toRoman()); |
|||
[ /mod swap ] dip <repetition> concat % |
|||
console.printLine("2008 : ", 2008.toRoman()); |
|||
] 2each drop ; |
|||
console.printLine("1666 : ", 1666.toRoman()) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 : MCMXC |
|||
2008 : MMVIII |
|||
1666 : MDCLXVI |
|||
</pre> |
|||
=={{header|Elixir}}== |
|||
{{trans|Erlang}} |
|||
<syntaxhighlight lang="elixir">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</syntaxhighlight> |
|||
'''Another:''' |
|||
{{trans|Ruby}} |
|||
<syntaxhighlight lang="elixir">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</syntaxhighlight> |
|||
'''Test:''' |
|||
<syntaxhighlight lang="elixir">Enum.each([1990, 2008, 1666], fn n -> |
|||
IO.puts "#{n}: #{Roman_numeral.encode(n)}" |
|||
end)</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990: MCMXC |
|||
2008: MMVIII |
|||
1666: MDCLXVI |
|||
</pre> |
|||
=={{header|Emacs Lisp}}== |
|||
<syntaxhighlight lang="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)))</syntaxhighlight> |
|||
=={{header|Erlang}}== |
|||
{{trans|OCaml}} |
|||
<syntaxhighlight lang="erlang">-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].</syntaxhighlight> |
|||
sample: |
|||
<pre> |
|||
1> c(roman). |
|||
{ok,roman} |
|||
2> roman:to_roman(1999). |
|||
"MCMXCIX" |
|||
3> roman:to_roman(25). |
|||
"XXV" |
|||
4> roman:to_roman(944). |
|||
"CMXLIV" |
|||
</pre> |
|||
Alternative: |
|||
<syntaxhighlight lang="erlang"> |
|||
-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}]. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
36> roman_numerals:encode_from_integer( 1990 ). |
|||
"MCMXC" |
|||
37> roman_numerals:encode_from_integer( 2008 ). |
|||
"MMVIII" |
|||
38> roman_numerals:encode_from_integer( 1666 ). |
|||
"MDCLXVI" |
|||
</pre> |
|||
=={{header|ERRE}}== |
|||
<syntaxhighlight lang="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 |
|||
</syntaxhighlight> |
|||
=={{header|Euphoria}}== |
|||
{{trans|BASIC}} |
|||
<syntaxhighlight lang="euphoria">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)})</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
2009 = MMIX |
|||
1666 = MDCLXVI |
|||
3888 = MMMDCCCLXXXVIII |
|||
</pre> |
|||
=={{header|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: |
|||
<syntaxhighlight lang="excel"> |
|||
=ROMAN(2013,0) |
|||
</syntaxhighlight> |
|||
It becomes: |
|||
<syntaxhighlight lang="text"> |
|||
MMXIII |
|||
</syntaxhighlight> |
|||
=={{header|F_Sharp|F#}}== |
|||
<syntaxhighlight lang="fsharp">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 |
|||
: >roman ( n -- str ) |
|||
| 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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>MCMXC |
|||
MMVIII |
|||
MDCLXVI</pre> |
|||
=={{header|Factor}}== |
|||
A roman numeral library ships with Factor. |
|||
<syntaxhighlight lang="factor">USE: roman |
|||
( scratchpad ) 3333 >roman . |
|||
"mmmcccxxxiii"</syntaxhighlight> |
|||
Parts of the implementation: |
|||
<syntaxhighlight lang="factor">CONSTANT: roman-digits |
|||
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" } |
|||
CONSTANT: roman-values |
|||
{ 1000 900 500 400 100 90 50 40 10 9 5 4 1 } |
|||
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 ;</syntaxhighlight> |
|||
=={{header|FALSE}}== |
=={{header|FALSE}}== |
||
< |
<syntaxhighlight lang="false">^$." " |
||
^$." " |
|||
[$999>][1000- "M"]# |
[$999>][1000- "M"]# |
||
$899> [ 900-"CM"]? |
$899> [ 900-"CM"]? |
||
Line 447: | Line 3,617: | ||
$ 4> [ 5- "V"]? |
$ 4> [ 5- "V"]? |
||
$ 3> [ 4-"IV"]? |
$ 3> [ 4-"IV"]? |
||
[$ ][ 1- "I"]#% |
[$ ][ 1- "I"]#%</syntaxhighlight> |
||
</lang> |
|||
=={{header|Fan}}== |
=={{header|Fan}}== |
||
<syntaxhighlight lang="fan">** |
|||
<lang Fan> |
|||
** |
|||
** converts a number to its roman numeral representation |
** converts a number to its roman numeral representation |
||
** |
** |
||
Line 489: | Line 3,657: | ||
} |
} |
||
}</syntaxhighlight> |
|||
} |
|||
</lang> |
|||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
<syntaxhighlight lang="forth">: vector create ( n -- ) 0 do , loop does> ( n -- ) swap cells + @ execute ; |
|||
\ these are ( numerals -- numerals ) |
|||
does> ( n -- ) swap cells + @ execute ; |
|||
: ,I dup c@ C, ; : ,V dup 1 + c@ C, ; : ,X dup 2 + c@ C, ; |
|||
\ these are ( numerals -- numerals ) |
|||
\ these are ( numerals -- ) |
|||
: .I dup c@ emit ; |
|||
:noname ,I ,X drop ; :noname ,V ,I ,I ,I drop ; :noname ,V ,I ,I drop ; |
|||
: .V dup 1 + c@ emit ; |
|||
:noname ,V ,I drop ; :noname ,V drop ; :noname ,I ,V drop ; |
|||
: .X dup 2 + c@ emit ; |
|||
:noname ,I ,I ,I drop ; :noname ,I ,I drop ; :noname ,I drop ; |
|||
' drop ( 0 : no output ) 10 vector ,digit |
|||
\ these are ( numerals -- ) |
|||
:noname .I .X drop ; |
|||
: roman-rec ( numerals n -- ) 10 /mod dup if >r over 2 + r> recurse else drop then ,digit ; |
|||
:noname .V .I .I .I drop ; |
|||
: roman ( n -- c-addr u ) |
|||
dup 0 4000 within 0= abort" EX LIMITO!" |
|||
:noname .V .I drop ; |
|||
HERE SWAP s" IVXLCDM" drop swap roman-rec HERE OVER - ; |
|||
:noname .I .V drop ; |
|||
1999 roman type \ MCMXCIX |
|||
25 roman type \ XXV |
|||
944 roman type \ CMXLIV</syntaxhighlight> |
|||
:noname .I drop ; |
|||
Alternative implementation |
|||
' drop \ 0: no output |
|||
<syntaxhighlight lang="forth">create romans 0 , 1 , 5 , 21 , 9 , 2 , 6 , 22 , 86 , 13 , |
|||
10 vector .digit |
|||
does> swap cells + @ ; |
|||
: roman-rec ( numerals n -- ) |
|||
: roman-digit ( a1 n1 a2 n2 -- a3) |
|||
10 /mod dup if >r over 2 + r> recurse else drop then .digit ; |
|||
drop >r romans |
|||
begin dup while tuck 4 mod 1- chars r@ + c@ over c! char+ swap 4 / repeat |
|||
: .roman ( n -- ) |
|||
r> drop drop |
|||
dup 0 4000 within 0= if ." EX LIMITO!" exit then |
|||
; |
|||
s" IVXLCDM" drop swap roman-rec ; |
|||
: (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</syntaxhighlight> |
|||
=={{header|Fortran}}== |
=={{header|Fortran}}== |
||
{{works with|Fortran|90 |
{{works with|Fortran|90 and later}} |
||
< |
<syntaxhighlight lang="fortran">program roman_numerals |
||
implicit none |
implicit none |
||
Line 557: | Line 3,735: | ||
end function roman |
end function roman |
||
end program roman_numerals |
end program roman_numerals</syntaxhighlight> |
||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
|||
MMIX |
MMIX |
||
MDCLXVI |
MDCLXVI |
||
MMMDCCCLXXXVIII |
MMMDCCCLXXXVIII |
||
</pre> |
|||
=={{header|Go}}== |
|||
For fluff, the unicode overbar is recognized as a factor of 1000, [http://en.wikipedia.org/wiki/Roman_numerals#Large_numbers as described in WP]. |
|||
If you see boxes in the code below, those are supposed to be the Unicode combining overline (U+0305) and look like {{overline|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...) |
|||
<syntaxhighlight lang="go">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") |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 == MCMXC |
|||
2008 == MMVIII |
|||
1666 == MDCLXVI |
|||
</pre> |
|||
=={{header|Golo}}== |
|||
<syntaxhighlight lang="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")) |
|||
}</syntaxhighlight> |
|||
=={{header|Groovy}}== |
|||
<syntaxhighlight lang="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'</syntaxhighlight> |
|||
=={{header|Haskell}}== |
=={{header|Haskell}}== |
||
Line 569: | Line 3,889: | ||
With an explicit decimal digit representation list: |
With an explicit decimal digit representation list: |
||
<syntaxhighlight lang="haskell">digit :: Char -> Char -> Char -> Integer -> String |
|||
<pre> |
|||
digit x y z k = |
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]] !! |
[[x], [x, x], [x, x, x], [x, y], [y], [y, x], [y, x, x], [y, x, x, x], [x, z]] !! |
||
(fromInteger k - 1) |
(fromInteger k - 1) |
||
toRoman :: Integer -> String |
toRoman :: Integer -> String |
||
toRoman 0 = "" |
toRoman 0 = "" |
||
toRoman x |
|||
toRoman x | x < 0 = error "Negative roman numeral" |
|||
| x < 0 = error "Negative roman numeral" |
|||
toRoman x |
|||
toRoman x | x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r where |
|||
| x >= 1000 = 'M' : toRoman (x - 1000) |
|||
(q,r) = x `divMod` 100 |
|||
toRoman x |
|||
toRoman x | x >= 10 = digit 'X' 'L' 'C' q ++ toRoman r where |
|||
| x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r |
|||
(q,r) = x `divMod` 10 |
|||
where |
|||
toRoman x = digit 'I' 'V' 'X' x |
|||
(q, r) = x `divMod` 100 |
|||
</pre> |
|||
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 () |
|||
Output: |
|||
main = print $ toRoman <$> [1999, 25, 944]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>["MCMXCIX","XXV","CMXLIV"]</pre> |
|||
or, defining '''romanFromInt''' in terms of mapAccumL |
|||
<syntaxhighlight lang="haskell">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 () |
|||
main = (putStrLn . unlines) (roman <$> [1666, 1990, 2008, 2016, 2018])</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>MDCLXVI |
|||
MCMXC |
|||
MMVIII |
|||
MMXVI |
|||
MMXVIII</pre> |
|||
With the Roman patterns abstracted, and in a simple logic programming idiom: |
|||
<syntaxhighlight lang="haskell"> |
|||
module Main where |
|||
------------------------ |
|||
-- ENCODER FUNCTION -- |
|||
------------------------ |
|||
romanDigits = "IVXLCDM" |
|||
-- Meaning and indices of the romanDigits sequence: |
|||
-- |
|||
-- magnitude | 1 5 | index |
|||
-- -----------|-------|------- |
|||
-- 0 | I V | 0 1 |
|||
-- 1 | X L | 2 3 |
|||
-- 2 | C D | 4 5 |
|||
-- 3 | M | 6 |
|||
-- |
|||
-- romanPatterns are index offsets into romanDigits, |
|||
-- from an index base of 2 * magnitude. |
|||
romanPattern 0 = [] -- empty string |
|||
romanPattern 1 = [0] -- I or X or C or M |
|||
romanPattern 2 = [0,0] -- II or XX... |
|||
romanPattern 3 = [0,0,0] -- III... |
|||
romanPattern 4 = [0,1] -- IV... |
|||
romanPattern 5 = [1] -- ... |
|||
romanPattern 6 = [1,0] |
|||
romanPattern 7 = [1,0,0] |
|||
romanPattern 8 = [1,0,0,0] |
|||
romanPattern 9 = [0,2] |
|||
encodeValue 0 _ = "" |
|||
encodeValue value magnitude = encodeValue rest (magnitude + 1) ++ digits |
|||
where |
|||
low = rem value 10 -- least significant digit (encoded now) |
|||
rest = div value 10 -- the other digits (to be encoded next) |
|||
indices = map addBase (romanPattern low) |
|||
addBase i = i + (2 * magnitude) |
|||
digits = map pickDigit indices |
|||
pickDigit i = romanDigits!!i |
|||
encode value = encodeValue value 0 |
|||
------------------ |
|||
-- TEST SUITE -- |
|||
------------------ |
|||
main = do |
|||
test "MCMXC" 1990 |
|||
test "MMVIII" 2008 |
|||
test "MDCLXVI" 1666 |
|||
test expected value = putStrLn ((show value) ++ " = " ++ roman ++ remark) |
|||
where |
|||
roman = encode value |
|||
remark = |
|||
" (" ++ |
|||
(if roman == expected then "PASS" |
|||
else ("FAIL, expected " ++ (show expected))) ++ ")" |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
<pre> |
||
1990 = MCMXC (PASS) |
|||
*Main> map toRoman [1999,25,944] |
|||
2008 = MMVIII (PASS) |
|||
["MCMXCIX","XXV","CMXLIV"] |
|||
1666 = MDCLXVI (PASS) |
|||
</pre> |
</pre> |
||
=={{header|HicEst}}== |
|||
<syntaxhighlight lang="hicest">CHARACTER Roman*20 |
|||
CALL RomanNumeral(1990, Roman) ! MCMXC |
|||
CALL RomanNumeral(2008, Roman) ! MMVIII |
|||
CALL RomanNumeral(1666, Roman) ! MDCLXVI |
|||
END |
|||
SUBROUTINE RomanNumeral( arabic, roman) |
|||
CHARACTER roman |
|||
DIMENSION ddec(13) |
|||
DATA ddec/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/ |
|||
roman = ' ' |
|||
todo = arabic |
|||
DO d = 1, 13 |
|||
DO rep = 1, todo / ddec(d) |
|||
roman = TRIM(roman) // TRIM(CHAR(d, 13, "M CM D CD C XC L XL X OX V IV I ")) |
|||
todo = todo - ddec(d) |
|||
ENDDO |
|||
ENDDO |
|||
END</syntaxhighlight> |
|||
=={{header|Hoon}}== |
|||
Library file (e.g. <code>/lib/rhonda.hoon</code>): |
|||
<syntaxhighlight lang="hoon">|% |
|||
++ parse |
|||
|= t=tape ^- @ud |
|||
=. t (cass t) |
|||
=| result=@ud |
|||
|- |
|||
?~ t result |
|||
?~ t.t (add result (from-numeral i.t)) |
|||
=+ [a=(from-numeral i.t) b=(from-numeral i.t.t)] |
|||
?: (gte a b) $(result (add result a), t t.t) |
|||
$(result (sub (add result b) a), t t.t.t) |
|||
++ yield |
|||
|= n=@ud ^- tape |
|||
=| result=tape |
|||
=/ values to-numeral |
|||
|- |
|||
?~ values result |
|||
?: (gte n -.i.values) |
|||
$(result (weld result +.i.values), n (sub n -.i.values)) |
|||
$(values t.values) |
|||
++ from-numeral |
|||
|= c=@t ^- @ud |
|||
?: =(c 'i') 1 |
|||
?: =(c 'v') 5 |
|||
?: =(c 'x') 10 |
|||
?: =(c 'l') 50 |
|||
?: =(c 'c') 100 |
|||
?: =(c 'd') 500 |
|||
?: =(c 'm') 1.000 |
|||
!! |
|||
++ to-numeral |
|||
^- (list [@ud tape]) |
|||
:* |
|||
[1.000 "m"] |
|||
[900 "cm"] |
|||
[500 "d"] |
|||
[400 "cd"] |
|||
[100 "c"] |
|||
[90 "xc"] |
|||
[50 "l"] |
|||
[40 "xl"] |
|||
[10 "x"] |
|||
[9 "ix"] |
|||
[5 "v"] |
|||
[4 "iv"] |
|||
[1 "i"] |
|||
~ |
|||
== |
|||
--</syntaxhighlight> |
|||
Script file ("generator") (e.g. <code>/gen/roman.hoon</code>): |
|||
<syntaxhighlight lang="hoon">/+ *roman |
|||
:- %say |
|||
|= [* [x=$%([%from-roman tape] [%to-roman @ud]) ~] ~] |
|||
:- %noun |
|||
^- tape |
|||
?- -.x |
|||
%from-roman "{<(parse +.x)>}" |
|||
%to-roman (yield +.x) |
|||
==</syntaxhighlight> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
|||
<syntaxhighlight lang="icon">link numbers # commas, roman |
|||
procedure main(arglist) |
|||
every x := !arglist do |
|||
write(commas(x), " -> ",roman(x)|"*** can't convert to Roman numerals ***") |
|||
end</syntaxhighlight> |
|||
{{libheader|Icon Programming Library}} |
|||
[http://www.cs.arizona.edu/icon/library/src/procs/numbers.icn numbers.icn provides roman] as seen below and is based upon a James Gimple SNOBOL4 function. |
|||
<syntaxhighlight lang="icon">procedure roman(n) #: convert integer to Roman numeral |
|||
local arabic, result |
|||
static equiv |
|||
initial equiv := ["","I","II","III","IV","V","VI","VII","VIII","IX"] |
|||
integer(n) > 0 | fail |
|||
result := "" |
|||
every arabic := !n do |
|||
result := map(result,"IVXLCDM","XLCDM**") || equiv[arabic + 1] |
|||
if find("*",result) then fail else return result |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>#roman.exe 3 4 8 49 2010 1666 3000 3999 4000 |
|||
3 -> III |
|||
4 -> IV |
|||
8 -> VIII |
|||
49 -> XLIX |
|||
2,010 -> MMX |
|||
1,666 -> MDCLXVI |
|||
3,999 -> MMMCMXCIX |
|||
4,000 -> *** can't convert to Roman numerals ***</pre> |
|||
=={{header|Intercal}}== |
|||
INTERCAL outputs numbers as Roman numerals by default, so this is surprisingly trivial for a language that generally tries to make things as difficult as possible. Although you do still have to <i>input</i> the numbers as spelled out digitwise in all caps. |
|||
<syntaxhighlight lang="intercal"> PLEASE WRITE IN .1 |
|||
DO READ OUT .1 |
|||
DO GIVE UP</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>$ ./roman |
|||
ONE SIX SIX SIX |
|||
MDCLXVI |
|||
</pre> |
|||
=={{header|Io}}== |
|||
{{trans|C#}} |
|||
<syntaxhighlight lang="io">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</syntaxhighlight> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
<tt>rfd</tt> obtains Roman numerals from decimals |
<tt>rfd</tt> obtains Roman numerals from decimals. |
||
<syntaxhighlight lang="j">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&|</syntaxhighlight> |
|||
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:<syntaxhighlight lang="j"> rfd 1234 |
|||
MCCXXXIV |
|||
rfd 567 |
|||
DLXVII |
|||
rfd 89 |
|||
LXXXIX</syntaxhighlight> |
|||
Derived from the [[j:Essays/Roman Numerals|J Wiki]]. Further examples of use will be found there. |
|||
dfr=: 3 : 0 |
|||
i=. 'IVXLCDM' i. y |
|||
d=. i{1 5 10 50 100 500 1000 |
|||
+/d*_1^i<}.i,_1 |
|||
) |
|||
r100 =. <;._1 ' C CC CCC CD D DC DCC DCCC CM' |
|||
r10 =. <;._1 ' X XX XXX XL L LX LXX LXXX XC' |
|||
r1 =. <;._1 ' I II III IV V VI VII VIII IX' |
|||
R1000=: , r100 ,&.>/ r10 ,&.>/ r1 |
|||
rfd=: 3 : 0 |
|||
('M'$~<.y%1000),R1000{::~1000|y |
|||
) |
|||
Copied, with permission, from the [http://www.jsoftware.com/jwiki/Essays/Roman_Numerals J Wiki]. Examples of use will be found there. |
|||
=={{header|Java}}== |
=={{header|Java}}== |
||
{{trans|Ada}} |
{{trans|Ada}} |
||
The |
The conversion function throws an IllegalArgumentException for non-positive numbers, since Java does not have unsigned primitives. |
||
{{works with|Java|1.5+}} |
|||
<lang java>public class RN{ |
|||
<syntaxhighlight lang="java5">public class RN { |
|||
public static void main(String args[]){ |
|||
System.out.println(roman(1999)); |
|||
enum Numeral { |
|||
System.out.println(roman(25)); |
|||
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); |
|||
System.out.println(roman(954)); |
|||
int weight; |
|||
} |
|||
public static String roman(long n){ |
|||
Numeral(int weight) { |
|||
if(n < 1) return null; |
|||
this.weight = weight; |
|||
String result = ""; |
|||
} |
|||
if(n >= 1000){ |
|||
}; |
|||
result+= (copies("M",(n / 1000))); |
|||
n%= 1000; |
|||
public static String roman(long n) { |
|||
} |
|||
if(n >= 900){ |
|||
if( n <= 0) { |
|||
result+= "CM"; |
|||
throw new IllegalArgumentException(); |
|||
n%= 900; |
|||
} |
|||
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); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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)</pre> |
|||
{{works with|Java|1.8+}} |
|||
<syntaxhighlight lang="java5">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); |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1999 = MCMXCIX |
|||
MCMXCIX = 1999 |
|||
25 = XXV |
|||
XXV = 25 |
|||
944 = CMXLIV |
|||
CMXLIV = 944</pre> |
|||
=={{header|JavaScript}}== |
|||
===ES5=== |
|||
====Iteration==== |
|||
{{trans|Tcl}} |
|||
<syntaxhighlight lang="javascript">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"</syntaxhighlight> |
|||
====Functional composition==== |
|||
<syntaxhighlight lang="javascript">(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); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="javascript">["MMXVI", "MCMXC", "MMVIII", "XIV.IX.MMXV", "MM", "MDCLXVI"]</syntaxhighlight> |
|||
===ES6=== |
|||
====Functional==== |
|||
{{Trans|Haskell}} |
|||
(mapAccumL version) |
|||
<syntaxhighlight lang="javascript">(() => { |
|||
"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 ---------------- |
|||
// Tuple (,) :: a -> b -> (a, b) |
|||
const Tuple = a => |
|||
// A pair of values, possibly of |
|||
// different types. |
|||
b => ({ |
|||
type: "Tuple", |
|||
"0": a, |
|||
"1": b, |
|||
length: 2, |
|||
*[Symbol.iterator]() { |
|||
for (const k in this) { |
|||
if (!isNaN(k)) { |
|||
yield this[k]; |
|||
} |
|||
} |
|||
} |
|||
}); |
|||
// 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, bs], x) => second( |
|||
v => [...bs, v] |
|||
)( |
|||
f(a)(x) |
|||
), |
|||
[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 => Tuple( |
|||
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(); |
|||
})();</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>MDCLXVI |
|||
MCMXC |
|||
MMVIII |
|||
MMXVI |
|||
MMXVIII |
|||
MMXX</pre> |
|||
====Declarative==== |
|||
<syntaxhighlight lang="javascript">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));</syntaxhighlight> |
|||
{{Out}} |
|||
<syntaxhighlight lang="javascript">MDCLXVI</syntaxhighlight> |
|||
=={{header|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=== |
|||
<syntaxhighlight lang="jq">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 ;</syntaxhighlight> |
|||
'''Test Cases''' |
|||
<syntaxhighlight lang="jq">def testcases: [1668, 1990, 2008, 2020, 4444, 5000, 8999, 39999, 89999, 399999]; |
|||
"Decimal => Roman:", |
|||
(testcases[] |
|||
| " \(.) => \(to_roman_numeral)" )</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
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 |
|||
</pre> |
|||
==="Orders of Magnitude" version=== |
|||
'''Translated from [[#Julia|Julia]]''' extended to 399,999 |
|||
<syntaxhighlight lang="jq">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; |
|||
</syntaxhighlight> |
|||
=={{header|Jsish}}== |
|||
This covers both Encode (toRoman) and Decode (fromRoman). |
|||
<syntaxhighlight lang="javascript">/* 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!= |
|||
*/</syntaxhighlight> |
|||
{{out}} |
|||
<pre>prompt$ jsish -u Roman.jsi |
|||
[PASS] Roman.jsi</pre> |
|||
=={{header|Julia}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
=={{header|Kotlin}}== |
|||
<syntaxhighlight lang="scala">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)) |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MDCLXVI |
|||
MMVIII |
|||
</pre> |
|||
Alternatively: |
|||
<syntaxhighlight lang="scala">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") |
|||
} |
|||
}</syntaxhighlight> |
|||
=={{header|Lasso}}== |
|||
<syntaxhighlight lang="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 |
|||
} |
} |
||
if(n >= 500){ |
|||
result+= "D"; |
|||
n%= 500; |
|||
} |
|||
if(n >= 400){ |
|||
result+= "CD"; |
|||
n%= 400; |
|||
} |
|||
if(n >= 100){ |
|||
result+= (copies("C",(n / 100))); |
|||
n%= 100; |
|||
} |
|||
if(n >= 90){ |
|||
result+= "XC"; |
|||
n%= 90; |
|||
} |
|||
if(n >= 50){ |
|||
result+= "L"; |
|||
n%= 50; |
|||
} |
|||
if(n >= 40){ |
|||
result+= "XL"; |
|||
n%= 40; |
|||
} |
|||
if(n >= 10){ |
|||
result+= (copies("X",(n / 10))); |
|||
n%= 10; |
|||
} |
|||
if(n == 9){ |
|||
result+= "IX"; |
|||
n= 0; |
|||
} |
|||
if(n >= 5){ |
|||
result+= "V"; |
|||
n%= 5; |
|||
} |
|||
if(n == 4){ |
|||
result+= "IV"; |
|||
n= 0; |
|||
} |
|||
result+= (copies("I",n)); |
|||
return result; |
|||
} |
} |
||
return #out |
|||
} |
|||
public static String copies(String a, int n){ |
|||
String result = ""; |
|||
'1990 in roman is '+encodeRoman(1990) |
|||
for(int i= 0;i < n;i++,result+= a); |
|||
br |
|||
return result; |
|||
'2008 in roman is '+encodeRoman(2008) |
|||
} |
|||
br |
|||
}</lang> |
|||
'1666 in roman is '+encodeRoman(1666)</syntaxhighlight> |
|||
Output: |
|||
MCMXCIX |
|||
XXV |
|||
CMXLIV |
|||
=={{header|LaTeX}}== |
=={{header|LaTeX}}== |
||
The macro <code>\Roman</code> is defined for uppercase roman numeral, accepting as ''argument'' a name of an existing counter. |
The macro <code>\Roman</code> is defined for uppercase roman numeral, accepting as ''argument'' a name of an existing counter. |
||
< |
<syntaxhighlight lang="latex">\documentclass{minimal} |
||
\newcounter{currentyear} |
|||
\setcounter{currentyear}{\year} |
|||
\begin{document} |
\begin{document} |
||
\newcounter{currentyear}\setcounter{currentyear}{\year} |
|||
Anno Domini \Roman{currentyear} |
Anno Domini \Roman{currentyear} |
||
\end{document}</ |
\end{document}</syntaxhighlight> |
||
=={{header|LiveCode}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
Examples |
|||
<pre>toRoman(2009) -- MMIX |
|||
toRoman(1666) -- MDCLXVI |
|||
toRoman(1984) -- MCMLXXXIV |
|||
toRoman(3888) -- MMMDCCCLXXXVIII</pre> |
|||
=={{header|Logo}}== |
=={{header|Logo}}== |
||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{works with|UCB Logo}} |
{{works with|UCB Logo}} |
||
<syntaxhighlight lang="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 |
|||
to digit :d :numerals |
|||
print roman 1999 ; MCMXCIX |
|||
if :d = 0 [output "||] |
|||
print roman 25 ; XXV |
|||
output apply (sentence "\( "word (item :d :patterns) "\)) :numerals |
|||
print roman 944 ; CMXLIV |
|||
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</syntaxhighlight> |
|||
=={{header|LOLCODE}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>2009 = MMIX |
|||
1666 = MDCLXVI |
|||
3888 = MMMDCCCLXXXVIII</pre> |
|||
=={{header|LotusScript}}== |
|||
<syntaxhighlight lang="lss"> |
|||
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 |
|||
</syntaxhighlight> |
|||
=={{header|Lua}}== |
|||
<syntaxhighlight lang="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()</syntaxhighlight> |
|||
=={{header|M4}}== |
=={{header|M4}}== |
||
<syntaxhighlight lang="m4">define(`roman',`ifelse(eval($1>=1000),1,`M`'roman(eval($1-1000))', |
|||
<lang 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>=900),1,`CM`'roman(eval($1-900))', |
||
`ifelse(eval($1>=500),1,`D`'roman(eval($1-500))', |
`ifelse(eval($1>=500),1,`D`'roman(eval($1-500))', |
||
Line 732: | Line 5,038: | ||
)')')')')')')')')')')')')dnl |
)')')')')')')')')')')')')dnl |
||
dnl |
dnl |
||
roman(3675) |
roman(3675)</syntaxhighlight> |
||
</lang> |
|||
{{out}} |
|||
Output: |
|||
<pre> |
<pre> |
||
MMMDCLXXV |
MMMDCLXXV |
||
</pre> |
</pre> |
||
=={{header| |
=={{header|Maple}}== |
||
<syntaxhighlight lang="maple">> for n in [ 1666, 1990, 2008 ] do printf( "%d\t%s\n", n, convert( n, 'roman' ) ) end: |
|||
Define a custom function that works on positive numbers (RomanForm[0] will not be evaluated): |
|||
1666 MDCLXVI |
|||
<lang Mathematica> |
|||
1990 MCMXC |
|||
RomanForm[i_Integer?Positive]:=Module[{num=i,string="",value, letters,digits}, |
|||
2008 MMVIII</syntaxhighlight> |
|||
digits={{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"}}; |
|||
While[num>0, |
|||
=={{header|Mathematica}}/{{header|Wolfram Language}}== |
|||
{value,letters}=Which@@Flatten[{num>=#[[1]],##}&/@digits,1]; |
|||
RomanNumeral is a built-in function in the Wolfram language. Examples: |
|||
num-=value; |
|||
<syntaxhighlight lang="mathematica">RomanNumeral[4] |
|||
string=string<>letters; |
|||
RomanNumeral[99] |
|||
]; |
|||
RomanNumeral[1337] |
|||
string |
|||
RomanNumeral[1666] |
|||
] |
|||
RomanNumeral[6889]</syntaxhighlight> |
|||
</lang> |
|||
Examples: |
|||
<lang Mathematica> |
|||
RomanForm[4] |
|||
RomanForm[99] |
|||
RomanForm[1337] |
|||
RomanForm[1666] |
|||
RomanForm[6889] |
|||
</lang> |
|||
gives back: |
gives back: |
||
<pre>IV |
|||
<lang Mathematica> |
|||
XCIX |
|||
IV |
|||
MCCCXXXVII |
|||
XCIX |
|||
MDCLXVI |
|||
MCCCXXXVII |
|||
MMMMMMDCCCLXXXIX</pre> |
|||
MDCLXVI |
|||
MMMMMMDCCCLXXXIX |
|||
=={{header|Mercury}}== |
|||
</lang> |
|||
The non-ceremonial work in this program starts at the function <code>to_roman/1</code>. 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.) |
|||
<code>to_roman/1</code> is just a string of chained function calls. The number is passed in as a string (and the <code>main/2</code> 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. |
|||
<code>build_roman/1</code> takes the lead character off the list (reversed numerals) and then recursively calls itself. It uses the <code>promote/2</code> 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 <code>build_roman/1</code> 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 <code>digit_to_roman/1</code>). |
|||
** 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 <code>to_roman/1</code>. |
|||
It is possible for this to be implemented differently even keeping the same algorithm. For example the <code>map</code> module from the standard library could be used for looking up conversions and promotions instead of having <code>digit_to_roman/1</code> and <code>promote</code>. 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 <code>main/2</code> predicate you can see one means of dealing with it. <code>main/2</code> *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 <code>foldl/4</code>'s provided higher-order predicate lambda. The call to <code>to_roman/1</code> 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 <code>pred(char, char)</code> (as is the case for <code>promote/2</code>), the underlying implementation *must* handle *all* values that a type <code>char</code> could possibly hold. It is trivial to see that our code does not. This means that, in theory, it is possible that <code>promote/2</code> (or <code>digit_to_roman/1</code>) could be passed a value which cannot be processed, thus triggering a false result, and thus being semi-deterministic. |
|||
=== roman.m === |
|||
<syntaxhighlight lang="mercury"> |
|||
:- 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. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
$ '''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'' |
|||
</pre> |
|||
=== roman2.m === |
|||
Another implementation using an algorithm inspired by [[#Erlang|the Erlang implementation]] could look like this: |
|||
<syntaxhighlight lang="mercury"> |
|||
:- 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. |
|||
</syntaxhighlight> |
|||
This implementation calculates the value of the thousands, then the hundreds, then the tens, then the ones. In each case it uses the <code>digit/4</code> 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. |
|||
=={{header|Miranda}}== |
|||
<syntaxhighlight lang="miranda">main :: [sys_message] |
|||
main = [ Stdout (show n ++ ": " ++ toroman n ++ "\n") |
|||
| n <- [1990, 2008, 1666, 2023]] |
|||
toroman :: num->[char] |
|||
toroman 0 = "" |
|||
toroman n = d ++ toroman (n - v) |
|||
where 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)] |
|||
(d, v) = hd [(d,v) | (d,v) <- digits; v <= n]</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990: MCMXC |
|||
2008: MMVIII |
|||
1666: MDCLXVI |
|||
2023: MMXXIII</pre> |
|||
=={{header|Modula-2}}== |
|||
{{trans|DWScript}} |
|||
{{works with|ADW Modula-2|any (Compile with the linker option ''Console Application'').}} |
|||
<syntaxhighlight lang="modula2"> |
|||
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. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXVIII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
=={{header|MUMPS}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{out}} |
|||
<pre>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</pre> |
|||
Another variant |
|||
<syntaxhighlight lang="mumps">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</syntaxhighlight> |
|||
=={{header|Nim}}== |
|||
{{trans|Python}} |
|||
<syntaxhighlight lang="nim">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</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 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</pre> |
|||
=={{header|Objeck}}== |
|||
{{trans|C sharp}} |
|||
<syntaxhighlight lang="objeck"> |
|||
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(); |
|||
} |
|||
} |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|OCaml}}== |
=={{header|OCaml}}== |
||
Line 774: | Line 5,458: | ||
With an explicit decimal digit representation list: |
With an explicit decimal digit representation list: |
||
<syntaxhighlight lang="ocaml">let digit x y z = function |
|||
<lang ocaml> |
|||
let digit x y z = function |
|||
1 -> [x] |
1 -> [x] |
||
| 2 -> [x;x] |
| 2 -> [x;x] |
||
Line 797: | Line 5,480: | ||
digit 'X' 'L' 'C' (x / 10) @ to_roman (x mod 10) |
digit 'X' 'L' 'C' (x / 10) @ to_roman (x mod 10) |
||
else |
else |
||
digit 'I' 'V' 'X' x |
digit 'I' 'V' 'X' x</syntaxhighlight> |
||
</lang> |
|||
Output: |
|||
{{out}} |
|||
<pre> |
<pre> |
||
# to_roman 1999;; |
# to_roman 1999;; |
||
Line 810: | Line 5,491: | ||
- : char list = ['C'; 'M'; 'X'; 'L'; 'I'; 'V'] |
- : char list = ['C'; 'M'; 'X'; 'L'; 'I'; 'V'] |
||
</pre> |
</pre> |
||
=={{header|Oforth}}== |
|||
<syntaxhighlight lang="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 ] ] ;</syntaxhighlight> |
|||
=={{header|OpenEdge/Progress}}== |
|||
<syntaxhighlight lang="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. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre>--------------------------- |
|||
Message (Press HELP to view stack trace) |
|||
--------------------------- |
|||
1990 MCMXC |
|||
2008 MMVIII |
|||
2000 MM |
|||
1666 MDCLXVI |
|||
--------------------------- |
|||
OK Help |
|||
---------------------------</pre> |
|||
=={{header|Oz}}== |
|||
{{trans|Haskell}} |
|||
<syntaxhighlight lang="oz">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}</syntaxhighlight> |
|||
=={{header|PARI/GP}}== |
|||
Old-style Roman numerals |
|||
<syntaxhighlight lang="parigp">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() |
|||
};</syntaxhighlight> |
|||
This simple version of medieval Roman numerals does not handle large numbers. |
|||
<syntaxhighlight lang="parigp">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() |
|||
};</syntaxhighlight> |
|||
=={{header|Pascal}}== |
|||
See [[Roman_numerals/Encode#Delphi | Delphi]] |
|||
=={{header|PascalABC.NET}}== |
|||
<syntaxhighlight lang="delphi"> |
|||
var anums := |1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1|; |
|||
var rnums := 'M CM D CD C XC L XL X IX V IV I'.split; |
|||
function ToRoman(x: integer): string; |
|||
begin |
|||
Result := ''; |
|||
foreach var (a,r) in anums.Zip(rnums) do |
|||
begin |
|||
var n := x div a; |
|||
x := x mod a; |
|||
Result += r * n; |
|||
end; |
|||
end; |
|||
begin |
|||
var 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|; |
|||
foreach var x in test do |
|||
Println($'{x} - {ToRoman(x)}') |
|||
end. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1666 - MDCLXVI |
|||
1945 - MCMXLV |
|||
1997 - MCMXCVII |
|||
1999 - MCMXCIX |
|||
2000 - MM |
|||
2008 - MMVIII |
|||
2010 - MMX |
|||
2011 - MMXI |
|||
2500 - MMD |
|||
3000 - MMM |
|||
3999 - MMMCMXCIX |
|||
</pre> |
|||
=={{header|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. |
|||
<syntaxhighlight lang="sgml"><@ DEFUDOLITLIT>_RO|__Transformer|<@ DEFKEYPAR>__NationalNumericID|2</@><@ LETRESCS%NNMPAR>...|1</@></@> |
|||
<@ ENU$$DLSTLITLIT>1990,2008,1,2,64,124,1666,10001|,| |
|||
<@ SAYELTLST>...</@> is <@ SAY_ROELTLSTLIT>...|RomanLowerUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanUpperUnicode</@> <@ SAY_ROELTLSTLIT>...|RomanASCII</@> |
|||
</@></syntaxhighlight> |
|||
Same code in padded-out, variable-length English dialect |
|||
<syntaxhighlight lang="sgml"><# 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</#> |
|||
</#></syntaxhighlight> |
|||
{{out}} Notice here the three different ways of representing the results. |
|||
For reasons for notational differences, see [[wp:Roman_numerals#Alternate_forms]] |
|||
<pre>1990 is ⅿⅽⅿⅹⅽ ⅯⅭⅯⅩⅭ MCMXC |
|||
2008 is ⅿⅿⅷ ⅯⅯⅧ MMVIII |
|||
1 is ⅰ Ⅰ I |
|||
2 is ⅱ Ⅱ II |
|||
64 is ⅼⅹⅳ ⅬⅩⅣ LXIV |
|||
124 is ⅽⅹⅹⅳ ⅭⅩⅩⅣ CXXIV |
|||
1666 is ⅿⅾⅽⅼⅹⅵ ⅯⅮⅭⅬⅩⅥ MDCLXVI |
|||
10001 is ⅿⅿⅿⅿⅿⅿⅿⅿⅿⅿⅰ ↂⅠ MMMMMMMMMMI</pre> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
==== Simple program ==== |
|||
{{works with|Lingua::Romana::Perligata}} |
|||
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. |
|||
Perligata outputs numbers in Arabic, but the verb ''come'' ("beautify") may be used to convert numbers to proper Roman numerals: |
|||
<syntaxhighlight lang="perl">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 { |
|||
per quisque in I tum C conscribementum sic |
|||
my($n, $r) = (shift, ''); |
|||
hoc tum duos multiplicamentum comementum egresso scribe. |
|||
($r, $n) = ('-', -$n) if $n < 0; # Optional handling of negative input |
|||
cis |
|||
foreach my $s (@symbols) { |
|||
my($arabic, $roman) = @$s; |
|||
($r, $n) = ($r .= $roman x int($n/$arabic), $n % $arabic) |
|||
if $n >= $arabic; |
|||
} |
|||
$r; |
|||
} |
|||
say roman($_) for 1..2012;</syntaxhighlight> |
|||
=={{header|Perl 6}}== |
|||
{{trans|Ruby}} |
|||
==== Using a module ==== |
|||
{{works with|Rakudo|#22 "Thousand Oaks"}} |
|||
<syntaxhighlight lang="perl">use Math::Roman qw/roman/; |
|||
say roman($_) for 1..2012'</syntaxhighlight> |
|||
==== Ported version of Raku ==== |
|||
<lang perl6>my %symbols = map {$^v => $^k}, { |
|||
<syntaxhighlight lang="perl">use List::MoreUtils qw( natatime ); |
|||
I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000 |
|||
}.kv; |
|||
my |
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;</syntaxhighlight> |
|||
=={{header|Phix}}== |
|||
<!--(phixonline)--> |
|||
<syntaxhighlight lang="phix"> |
|||
with javascript_semantics |
|||
function toRoman(integer v) |
|||
sequence 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 {v,res} -- (for output) |
|||
end function |
|||
?apply({1990,2008,1666},toRoman) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
{{1990,"MCMXC"},{2008,"MMVIII"},{1666,"MDCLXVI"}} |
|||
</pre> |
|||
=== cheating slightly === |
|||
<syntaxhighlight lang="phix"> |
|||
with javascript_semantics |
|||
requires("1.0.5") |
|||
function toRoman(integer n) |
|||
return {n,sprintf("%R",n)} |
|||
end function |
|||
</syntaxhighlight> |
|||
same output (builtins\VM\pprntfN.e/toRoman() is somewhat more obfuscated and faster than the above) |
|||
=={{header|Phixmonti}}== |
|||
<syntaxhighlight lang="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</syntaxhighlight> |
|||
{{trans|Lua}} |
|||
<syntaxhighlight lang="phixmonti">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</syntaxhighlight> |
|||
Without vars |
|||
<syntaxhighlight lang="phixmonti">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</syntaxhighlight> |
|||
=={{header|PHP}}== |
|||
{{works with|PHP|4+ tested in 5.2.12}} |
|||
<syntaxhighlight lang="php"> |
|||
/** |
|||
* 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; |
|||
} |
|||
</syntaxhighlight> |
|||
=={{header|Picat}}== |
|||
<syntaxhighlight lang="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.</syntaxhighlight> |
|||
{{out}} |
|||
<pre> 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</pre> |
|||
===Longest numeral=== |
|||
Which number encodes to the longest Roman numerals in the interval 1..4000: |
|||
<syntaxhighlight lang="picat">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.</syntaxhighlight> |
|||
{{out}} |
|||
sub roman (Int $n where { $n > 0 }) { |
|||
<pre>[15 = 3888 = MMMDCCCLXXXVIII,14 = 3887 = MMMDCCCLXXXVII]</pre> |
|||
if %symbols{$n} -> $sym { return $sym }; |
|||
for @subtractors -> $cut, $minus { |
|||
=={{header|PicoLisp}}== |
|||
$cut < $n |
|||
<syntaxhighlight lang="picolisp">(de roman (N) |
|||
and return %symbols{$cut} ~ roman($n - $cut); |
|||
(pack |
|||
$cut - $minus <= $n |
|||
(make |
|||
and return %symbols{$minus} ~ roman($n + $minus); |
|||
(mapc |
|||
'((C D) |
|||
}</lang> |
|||
(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) ) ) ) )</syntaxhighlight> |
|||
{{out}} |
|||
<pre>: (roman 1009) |
|||
-> "MIX" |
|||
: (roman 1666) |
|||
-> "MDCLXVI"</pre> |
|||
=={{header|Pike}}== |
|||
<syntaxhighlight lang="pike">import String; |
|||
int main(){ |
|||
write(int2roman(2009) + "\n"); |
|||
write(int2roman(1666) + "\n"); |
|||
write(int2roman(1337) + "\n"); |
|||
}</syntaxhighlight> |
|||
=={{header|PL/I}}== |
|||
<syntaxhighlight lang="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; |
|||
</syntaxhighlight> |
|||
Results: |
|||
<pre> |
|||
11 XI |
|||
1990 MCMXC |
|||
2008 MMVIII |
|||
1666 MDCLXVI |
|||
1999 MCMXCIX |
|||
</pre> |
|||
=={{header|PL/SQL}}== |
|||
<syntaxhighlight lang="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; |
|||
</syntaxhighlight> |
|||
=={{header|plainTeX}}== |
=={{header|plainTeX}}== |
||
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. |
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. |
||
< |
<syntaxhighlight lang="tex">\def\upperroman#1{\uppercase\expandafter{\romannumeral#1}} |
||
Anno Domini \upperroman{\year} |
Anno Domini \upperroman{\year} |
||
\bye</ |
\bye</syntaxhighlight> |
||
=={{header|PowerShell}}== |
|||
<syntaxhighlight lang="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 |
|||
} |
|||
</syntaxhighlight> |
|||
<syntaxhighlight lang="powershell"> |
|||
19,4,0,2479,3001 | ToRoman |
|||
</syntaxhighlight> |
|||
{{Out}} |
|||
<pre> |
|||
XIX |
|||
IV |
|||
MMCDLXXIX |
|||
MMMI |
|||
</pre> |
|||
=={{header|Prolog}}== |
|||
{{works with|SWI-Prolog}} |
|||
{{libheader|clpfd}} |
|||
Library clpfd assures that the program works in both managements : Roman towards Arabic and Arabic towards Roman. |
|||
<syntaxhighlight lang="prolog">:- 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, u) --> ['IX']. |
|||
unity(9, t) --> ['XC']. |
|||
unity(9, h) --> ['CM']. |
|||
unity(9, th)--> ['MMMMMMMMM']. |
|||
unity(0, _) --> []. |
|||
unity(V, U)--> |
|||
{V #> 5, |
|||
V1 #= V - 5}, |
|||
unity(5, U), |
|||
unity(V1, U). |
|||
unity(V, U) --> |
|||
{V #> 1, V #< 4, |
|||
V1 #= V-1}, |
|||
unity(1, U), |
|||
unity(V1, U). |
|||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|||
% Extraction of roman "lexeme" |
|||
parse_Roman(['C','M'|T]) --> |
|||
['CM'], |
|||
parse_Roman(T). |
|||
parse_Roman(['C','D'|T]) --> |
|||
['CD'], |
|||
parse_Roman(T). |
|||
parse_Roman(['X','C'| T]) --> |
|||
['XC'], |
|||
parse_Roman(T). |
|||
parse_Roman(['X','L'| T]) --> |
|||
['XL'], |
|||
parse_Roman(T). |
|||
parse_Roman(['I','X'| T]) --> |
|||
['IX'], |
|||
parse_Roman(T). |
|||
parse_Roman(['I','V'| T]) --> |
|||
['IV'], |
|||
parse_Roman(T). |
|||
parse_Roman([H | T]) --> |
|||
[H], |
|||
parse_Roman(T). |
|||
parse_Roman([]) --> |
|||
[]. |
|||
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
|||
my_print(A, R) :- |
|||
format('~w in roman is ~w~n', [A, R]). |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> ?- roman. |
|||
1789 in roman is MDCCLXXXIX |
|||
2010 in roman is MMX |
|||
110 in roman is CX |
|||
1449 in roman is MCDXLIX |
|||
1666 in roman is MDCLXVI |
|||
true . |
|||
</pre> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
===Pythonic=== |
|||
<lang python>roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands # |
|||
<syntaxhighlight lang="python">import roman |
|||
print(roman.toRoman(2022))</syntaxhighlight> |
|||
===Minimalistic structuralism=== |
|||
<syntaxhighlight lang="python">def toRoman(n): |
|||
res='' #converts int to str(Roman numeral) |
|||
reg=n #using the numerals (M,D,C,L,X,V,I) |
|||
if reg<4000:#no more than three repetitions |
|||
while reg>=1000: #thousands up to MMM |
|||
res+='M' #MAX is MMMCMXCIX |
|||
reg-=1000 |
|||
if reg>=900: #nine hundreds in 900-999 |
|||
res+='CM' |
|||
reg-=900 |
|||
if reg>=500: #five hudreds in 500-899 |
|||
res+='D' |
|||
reg-=500 |
|||
if reg>=400: #four hundreds in 400-499 |
|||
res+='CD' |
|||
reg-=400 |
|||
while reg>=100: #hundreds in 100-399 |
|||
res+='C' |
|||
reg-=100 |
|||
if reg>=90: #nine tens in 90-99 |
|||
res+='XC' |
|||
reg-=90 |
|||
if reg>=50: #five Tens in 50-89 |
|||
res+='L' |
|||
reg-=50 |
|||
if reg>=40: |
|||
res+='XL' #four Tens |
|||
reg-=40 |
|||
while reg>=10: |
|||
res+="X" #tens |
|||
reg-=10 |
|||
if reg>=9: |
|||
res+='IX' #nine Units |
|||
reg-=9 |
|||
if reg>=5: |
|||
res+='V' #five Units |
|||
reg-=5 |
|||
if reg>=4: |
|||
res+='IV' #four Units |
|||
reg-=4 |
|||
while reg>0: #three or less Units |
|||
res+='I' |
|||
reg-=1 |
|||
return res</syntaxhighlight> |
|||
===Imperative=== |
|||
# Version for Python 2 |
|||
<syntaxhighlight lang="python">roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands # |
|||
adjust_roman = "CCXXmmccxxii"; |
adjust_roman = "CCXXmmccxxii"; |
||
arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1); |
arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1); |
||
Line 872: | Line 6,353: | ||
2000,2008,2500,3000,4000,4999,5000,6666,10000,50000,100000,500000,1000000); |
2000,2008,2500,3000,4000,4999,5000,6666,10000,50000,100000,500000,1000000); |
||
for val in test: |
for val in test: |
||
print '%d - %s'%(val, arabic_to_roman(val)) |
print '%d - %s'%(val, arabic_to_roman(val))</syntaxhighlight> |
||
An alternative which uses the divmod() function<syntaxhighlight lang="python">romanDgts= 'ivxlcdmVXLCDM_' |
|||
</lang> |
|||
An alternative which uses the divmod() function <lang python>romanDgts= 'ivxlcdmVXLCDM_' |
|||
def ToRoman(num): |
def ToRoman(num): |
||
Line 889: | Line 6,369: | ||
else: |
else: |
||
namoR += r*romanDgts[rdix] + (romanDgts[rdix+1] if(v==1) else '') |
namoR += r*romanDgts[rdix] + (romanDgts[rdix+1] if(v==1) else '') |
||
return namoR[-1::-1]</ |
return namoR[-1::-1]</syntaxhighlight> |
||
It is more Pythonic to use zip to iterate over two lists together: |
|||
<syntaxhighlight lang="python">anums = [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".split() |
|||
def to_roman(x): |
|||
ret = [] |
|||
for a,r in zip(anums, rnums): |
|||
n,x = divmod(x,a) |
|||
ret.append(r*n) |
|||
return ''.join(ret) |
|||
if __name__ == "__main__": |
|||
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) |
|||
for val in test: |
|||
print '%d - %s'%(val, to_roman(val)) |
|||
</syntaxhighlight> |
|||
# Version for Python 3 |
|||
<syntaxhighlight lang="python">def arabic_to_roman(dclxvi): |
|||
#=========================== |
|||
'''Convert an integer from the decimal notation to the Roman notation''' |
|||
org = dclxvi; # 666 # |
|||
out = ""; |
|||
for scale, arabic_scale in enumerate(arabic): |
|||
if org == 0: break |
|||
multiples = org // arabic_scale; |
|||
org -= arabic_scale * multiples; |
|||
out += roman[scale] * multiples; |
|||
if (org >= -adjust_arabic[scale] + arabic_scale): |
|||
org -= -adjust_arabic[scale] + arabic_scale; |
|||
out += adjust_roman[scale] + roman[scale] |
|||
return out |
|||
if __name__ == "__main__": |
|||
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); |
|||
for val in test: |
|||
print("%8d %s" %(val, arabic_to_roman(val)))</syntaxhighlight> |
|||
===Declarative=== |
|||
Less readable, but a 'one liner': |
|||
<syntaxhighlight lang="python">rnl = [ { '4' : 'MMMM', '3' : 'MMM', '2' : 'MM', '1' : 'M', '0' : '' }, { '9' : 'CM', '8' : 'DCCC', '7' : 'DCC', |
|||
'6' : 'DC', '5' : 'D', '4' : 'CD', '3' : 'CCC', '2' : 'CC', '1' : 'C', '0' : '' }, { '9' : 'XC', |
|||
'8' : 'LXXX', '7' : 'LXX', '6' : 'LX', '5' : 'L', '4' : 'XL', '3' : 'XXX', '2' : 'XX', '1' : 'X', |
|||
'0' : '' }, { '9' : 'IX', '8' : 'VIII', '7' : 'VII', '6' : 'VI', '5' : 'V', '4' : 'IV', '3' : 'III', |
|||
'2' : 'II', '1' : 'I', '0' : '' }] |
|||
# Option 1 |
|||
def number2romannumeral(n): |
|||
return ''.join([rnl[x][y] for x, y in zip(range(4), str(n).zfill(4)) if n < 5000 and n > -1]) |
|||
# Option 2 |
|||
def number2romannumeral(n): |
|||
return reduce(lambda x, y: x + y, map(lambda x, y: rnl[x][y], range(4), str(n).zfill(4))) if -1 < n < 5000 else None</syntaxhighlight> |
|||
Or, defining '''roman''' in terms of '''mapAccumL''': |
|||
{{works with|Python|3}} |
|||
{{Trans|Haskell}} |
|||
<syntaxhighlight lang="python">'''Encoding Roman Numerals''' |
|||
from functools import reduce |
|||
from itertools import chain |
|||
# romanFromInt :: Int -> String |
|||
def romanFromInt(n): |
|||
'''A string of Roman numerals encoding an integer.''' |
|||
def go(a, ms): |
|||
m, s = ms |
|||
q, r = divmod(a, m) |
|||
return (r, s * q) |
|||
return concat(snd(mapAccumL(go)(n)( |
|||
zip([ |
|||
1000, 900, 500, 400, 100, 90, 50, |
|||
40, 10, 9, 5, 4, 1 |
|||
], [ |
|||
'M', 'CM', 'D', 'CD', 'C', 'XC', 'L', |
|||
'XL', 'X', 'IX', 'V', 'IV', 'I' |
|||
]) |
|||
))) |
|||
# ------------------------- TEST ------------------------- |
|||
# main :: IO () |
|||
def main(): |
|||
'''Sample of years''' |
|||
for s in [ |
|||
romanFromInt(x) for x in [ |
|||
1666, 1990, 2008, 2016, 2018, 2020 |
|||
] |
|||
]: |
|||
print(s) |
|||
# ------------------ GENERIC FUNCTIONS ------------------- |
|||
# concat :: [[a]] -> [a] |
|||
# concat :: [String] -> String |
|||
def concat(xxs): |
|||
'''The concatenation of all the elements in a list.''' |
|||
xs = list(chain.from_iterable(xxs)) |
|||
unit = '' if isinstance(xs, str) else [] |
|||
return unit if not xs else ( |
|||
''.join(xs) if isinstance(xs[0], str) else xs |
|||
) |
|||
# mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) |
|||
def mapAccumL(f): |
|||
'''A tuple of an accumulation and a list derived by a |
|||
combined map and fold, |
|||
with accumulation from left to right.''' |
|||
def go(a, x): |
|||
tpl = f(a[0], x) |
|||
return (tpl[0], a[1] + [tpl[1]]) |
|||
return lambda acc: lambda xs: ( |
|||
reduce(go, xs, (acc, [])) |
|||
) |
|||
# snd :: (a, b) -> b |
|||
def snd(tpl): |
|||
'''Second component of a tuple.''' |
|||
return tpl[1] |
|||
# MAIN --- |
|||
if __name__ == '__main__': |
|||
main()</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>MDCLXVI |
|||
MCMXC |
|||
MMVIII |
|||
MMXVI |
|||
MMXVIII |
|||
MMXX</pre> |
|||
=={{header|Quackery}}== |
|||
Pasting epitomised. |
|||
<syntaxhighlight lang="quackery"> [ $ "" |
|||
swap 1000 /mod $ "M" rot of rot swap join swap |
|||
dup 900 < not if [ 900 - dip [ $ "CM" join ] ] |
|||
dup 500 < not if [ 500 - dip [ $ "D" join ] ] |
|||
dup 400 < not if [ 400 - dip [ $ "CD" join ] ] |
|||
100 /mod $ "C" rot of rot swap join swap |
|||
dup 90 < not if [ 90 - dip [ $ "XC" join ] ] |
|||
dup 50 < not if [ 50 - dip [ $ "L" join ] ] |
|||
dup 40 < not if [ 40 - dip [ $ "XL" join ] ] |
|||
10 /mod $ "X" rot of rot swap join swap |
|||
dup 9 < not if [ 9 - dip [ $ "IX" join ] ] |
|||
dup 5 < not if [ 5 - dip [ $ "V" join ] ] |
|||
dup 4 < not if [ 4 - dip [ $ "IV" join ] ] |
|||
$ "I" swap of join ] |
|||
is ->roman ( n --> $ ) |
|||
1990 dup echo say " = " ->roman echo$ cr |
|||
2008 dup echo say " = " ->roman echo$ cr |
|||
1666 dup echo say " = " ->roman echo$ cr</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>1990 = MCMXC |
|||
2008 = MMVIII |
|||
1666 = MDCLXVI</pre> |
|||
=={{header|R}}== |
=={{header|R}}== |
||
R has a built-in function, [https://svn.r-project.org/R/trunk/src/library/utils/R/roman.R as.roman], for conversion to |
R has a built-in function, <code>[https://svn.r-project.org/R/trunk/src/library/utils/R/roman.R as.roman]</code>, for conversion to Roman numerals. The implementation details are found in <code>utils:::.numeric2roman</code> (see previous link), and <code>utils:::.roman2numeric</code>, for conversion back to Arabic decimals. |
||
<syntaxhighlight lang="r">as.roman(1666) # MDCLXVI</syntaxhighlight> |
|||
<lang R> |
|||
Since the object <code>as.roman</code> creates is just an integer vector with a class, you can do arithmetic with Roman numerals: |
|||
as.roman(1666) # MDCLXVI |
|||
<syntaxhighlight lang="r">as.roman(1666) + 334 # MM</syntaxhighlight> |
|||
</lang> |
|||
=={{header|Racket}}== |
|||
Straight recursion: |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
(define (encode/roman number) |
|||
(cond ((>= number 1000) (string-append "M" (encode/roman (- number 1000)))) |
|||
((>= number 900) (string-append "CM" (encode/roman (- number 900)))) |
|||
((>= number 500) (string-append "D" (encode/roman (- number 500)))) |
|||
((>= number 400) (string-append "CD" (encode/roman (- number 400)))) |
|||
((>= number 100) (string-append "C" (encode/roman (- number 100)))) |
|||
((>= number 90) (string-append "XC" (encode/roman (- number 90)))) |
|||
((>= number 50) (string-append "L" (encode/roman (- number 50)))) |
|||
((>= number 40) (string-append "XL" (encode/roman (- number 40)))) |
|||
((>= number 10) (string-append "X" (encode/roman (- number 10)))) |
|||
((>= number 9) (string-append "IX" (encode/roman (- number 9)))) |
|||
((>= number 5) (string-append "V" (encode/roman (- number 5)))) |
|||
((>= number 4) (string-append "IV" (encode/roman (- number 4)))) |
|||
((>= number 1) (string-append "I" (encode/roman (- number 1)))) |
|||
(else "")))</syntaxhighlight> |
|||
Using for/fold and quotient/remainder to remove repetition: |
|||
<syntaxhighlight lang="racket">#lang racket |
|||
(define (number->list n) |
|||
(for/fold ([result null]) |
|||
([decimal '(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)]) |
|||
#:break (= n 0) |
|||
(let-values ([(q r) (quotient/remainder n decimal)]) |
|||
(set! n r) |
|||
(append result (make-list q roman))))) |
|||
(define (encode/roman number) |
|||
(string-join (map symbol->string (number->list number)) "")) |
|||
(for ([n '(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)]) |
|||
(printf "~a ~a\n" n (encode/roman n)))</syntaxhighlight> |
|||
=={{header|Raku}}== |
|||
(formerly Perl 6) |
|||
<syntaxhighlight lang="raku" line>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; |
|||
multi sub roman (0) { '' } |
|||
multi sub roman (Int $n) { |
|||
for @subtractors -> $cut, $minus { |
|||
$n >= $cut |
|||
and return %symbols{$cut} ~ roman($n - $cut); |
|||
$n >= $cut - $minus |
|||
and return %symbols{$minus} ~ roman($n + $minus); |
|||
} |
|||
} |
|||
# Sample usage |
|||
for 1 .. 2_010 -> $x { |
|||
say roman($x); |
|||
}</syntaxhighlight> |
|||
=={{header|Red}}== |
|||
Straight iterative solution: |
|||
<syntaxhighlight lang="red"> |
|||
Red [] |
|||
table: [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: function [n [integer!] return: [string!]][ |
|||
out: copy "" |
|||
foreach [a r] table [while [n >= a][append out r n: n - a]] |
|||
out |
|||
] |
|||
foreach number [40 33 1888 2016][print [number ":" to-Roman number]] |
|||
</syntaxhighlight> |
|||
Straight recursive solution: |
|||
<syntaxhighlight lang="red"> |
|||
Red [] |
|||
table: [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: func [n [integer!] return: [string!]][ |
|||
case [ |
|||
tail? table [table: head table copy ""] |
|||
table/1 > n [table: skip table 2 to-Roman n] |
|||
'else [append copy form table/2 to-Roman n - table/1] |
|||
] |
|||
] |
|||
foreach number [40 33 1888 2016][print [number ":" to-Roman number]] |
|||
</syntaxhighlight> |
|||
This solution builds, using metaprogramming, a `case` table, that relies on recursion to convert every digit. |
|||
<syntaxhighlight lang="red"> |
|||
Red [] |
|||
to-Roman: function [n [integer!]] reduce [ |
|||
'case collect [ |
|||
foreach [a r] [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][ |
|||
keep compose/deep [n >= (a) [append copy (form r) any [to-Roman n - (a) copy ""]]] |
|||
] |
|||
] |
|||
] |
|||
foreach number [40 33 1888 2016][print [number ":" to-Roman number]] |
|||
</syntaxhighlight> |
|||
=={{header|Retro}}== |
|||
This is a port of the [[Forth]] code; but returns a string rather than displaying the roman numerals. It only handles numbers between 1 and 3999. |
|||
<syntaxhighlight lang="retro"> |
|||
: vector ( ...n"- ) |
|||
here [ &, times ] dip : .data ` swap ` + ` @ ` do ` ; ; |
|||
: .I dup @ ^buffer'add ; |
|||
: .V dup 1 + @ ^buffer'add ; |
|||
: .X dup 2 + @ ^buffer'add ; |
|||
[ .I .X drop ] |
|||
[ .V .I .I .I drop ] |
|||
[ .V .I .I drop ] |
|||
[ .V .I drop ] |
|||
[ .V drop ] |
|||
[ .I .V drop ] |
|||
[ .I .I .I drop ] |
|||
[ .I .I drop ] |
|||
[ .I drop ] |
|||
&drop |
|||
10 vector .digit |
|||
: record ( an- ) |
|||
10 /mod dup [ [ over 2 + ] dip record ] &drop if .digit ; |
|||
: toRoman ( n-a ) |
|||
here ^buffer'set |
|||
dup 1 3999 within 0 = |
|||
[ "EX LIMITO!\n" ] [ "IVXLCDM" swap record here ] if ; |
|||
</syntaxhighlight> |
|||
=={{header|REXX}}== |
|||
===version 1=== |
|||
<syntaxhighlight lang="rexx">roman: procedure |
|||
arg number |
|||
/* handle only 1 to 3999, else return ? */ |
|||
if number >= 4000 | number <= 0 then return "?" |
|||
romans = " M CM D CD C XC L XL X IX V IV I" |
|||
arabic = "1000 900 500 400 100 90 50 40 10 9 5 4 1" |
|||
result = "" |
|||
do i = 1 to words(romans) |
|||
do while number >= word(arabic,i) |
|||
result = result || word(romans,i) |
|||
number = number - word(arabic,i) |
|||
end |
|||
end |
|||
return result</syntaxhighlight> |
|||
===version 2=== |
|||
This version of a REXX program allows almost any non-negative decimal integer. |
|||
Most people think that the Romans had no word for "zero". The Roman numeral system has no need for a |
|||
<br>zero ''placeholder'', so there was no name for it (just as we have no name for a "¶" in the middle of our |
|||
<br>numbers ─── as we don't have that possibility). However, the Romans did have a name for zero (or nothing). |
|||
<br>In fact the Romans had several names for zero (see the REXX code), as does modern English. In American |
|||
<br>English, many words can be used for '''0''': zero, nothing, naught, bupkis, zilch, goose-egg, nebbish, squat, nil, |
|||
<br>crapola, what-Patty-shot-at, nineteen (only in cribbage), love (in tennis), etc. |
|||
Also, this REXX version supports large numbers (with parentheses and deep parentheses). |
|||
(This REXX code was ripped out of my general routine that also supported versions for '''Attic''', '''ancient Roman''', |
|||
<br>and '''modern Roman''' numerals.) |
|||
The general REXX code is bulkier than most at it deals with ''any'' non-negative decimal number, and more |
|||
<br>boilerplate code is in the general REXX code to handle the above versions. |
|||
<syntaxhighlight lang="rexx">/*REXX program converts (Arabic) non─negative decimal integers (≥0) ───► Roman numerals.*/ |
|||
numeric digits 10000 /*decimal digs can be higher if wanted.*/ |
|||
parse arg # /*obtain optional integers from the CL.*/ |
|||
@er= "argument isn't a non-negative integer: " /*literal used when issuing error msg. */ |
|||
if #='' then /*Nothing specified? Then generate #s.*/ |
|||
do |
|||
do j= 0 by 11 to 111; #=# j; end |
|||
#=# 49; do k=88 by 100 to 1200; #=# k; end |
|||
#=# 1000 2000 3000 4000 5000 6000; do m=88 by 200 to 1200; #=# m; end |
|||
#=# 1304 1405 1506 1607 1708 1809 1910 2011; do p= 4 to 50; #=# 10**p; end |
|||
end /*finished with generation of numbers. */ |
|||
do i=1 for words(#); x=word(#, i) /*convert each of the numbers───►Roman.*/ |
|||
if \datatype(x, 'W') | x<0 then say "***error***" @er x /*¬ whole #? negative?*/ |
|||
say right(x, 55) dec2rom(x) |
|||
end /*i*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
|||
dec2rom: procedure; parse arg n,# /*obtain the number, assign # to a null*/ |
|||
n=space(translate(n/1, , ','), 0) /*remove commas from normalized integer*/ |
|||
nulla= 'ZEPHIRUM NULLAE NULLA NIHIL' /*Roman words for "nothing" or "none". */ |
|||
if n==0 then return word(nulla, 1) /*return a Roman word for "zero". */ |
|||
maxnp=(length(n)-1)%3 /*find max(+1) # of parenthesis to use.*/ |
|||
highPos=(maxnp+1)*3 /*highest position of number. */ |
|||
nn=reverse( right(n, highPos, 0) ) /*digits for Arabic──►Roman conversion.*/ |
|||
do j=highPos to 1 by -3 |
|||
_=substr(nn, j, 1); select /*════════════════════hundreds.*/ |
|||
when _==9 then hx='CM' |
|||
when _>=5 then hx='D'copies("C", _-5) |
|||
when _==4 then hx='CD' |
|||
otherwise hx= copies('C', _) |
|||
end /*select hundreds*/ |
|||
_=substr(nn, j-1, 1); select /*════════════════════════tens.*/ |
|||
when _==9 then tx='XC' |
|||
when _>=5 then tx='L'copies("X", _-5) |
|||
when _==4 then tx='XL' |
|||
otherwise tx= copies('X', _) |
|||
end /*select tens*/ |
|||
_=substr(nn, j-2, 1); select /*═══════════════════════units.*/ |
|||
when _==9 then ux='IX' |
|||
when _>=5 then ux='V'copies("I", _-5) |
|||
when _==4 then ux='IV' |
|||
otherwise ux= copies('I', _) |
|||
end /*select units*/ |
|||
$=hx || tx || ux |
|||
if $\=='' then #=# || copies("(", (j-1)%3)$ ||copies(')', (j-1)%3) |
|||
end /*j*/ |
|||
if pos('(I',#)\==0 then do i=1 for 4 /*special case: M,MM,MMM,MMMM.*/ |
|||
if i==4 then _ = '(IV)' |
|||
else _ = '('copies("I", i)')' |
|||
if pos(_, #)\==0 then #=changestr(_, #, copies('M', i)) |
|||
end /*i*/ |
|||
return #</syntaxhighlight> |
|||
Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]]. <br><br> |
|||
'''output''' when using the default (internal) input): |
|||
<pre style="height:80ex"> |
|||
0 ZEPHIRUM |
|||
11 XI |
|||
22 XXII |
|||
33 XXXIII |
|||
44 XLIV |
|||
55 LV |
|||
66 LXVI |
|||
77 LXXVII |
|||
88 LXXXVIII |
|||
99 XCIX |
|||
110 CX |
|||
49 XLIX |
|||
88 LXXXVIII |
|||
188 CLXXXVIII |
|||
288 CCLXXXVIII |
|||
388 CCCLXXXVIII |
|||
488 CDLXXXVIII |
|||
588 DLXXXVIII |
|||
688 DCLXXXVIII |
|||
788 DCCLXXXVIII |
|||
888 DCCCLXXXVIII |
|||
988 CMLXXXVIII |
|||
1088 MLXXXVIII |
|||
1188 MCLXXXVIII |
|||
1000 M |
|||
2000 MM |
|||
3000 MMM |
|||
4000 MMMM |
|||
5000 (V) |
|||
6000 (VI) |
|||
88 LXXXVIII |
|||
288 CCLXXXVIII |
|||
488 CDLXXXVIII |
|||
688 DCLXXXVIII |
|||
888 DCCCLXXXVIII |
|||
1088 MLXXXVIII |
|||
1304 MCCCIV |
|||
1405 MCDV |
|||
1506 MDVI |
|||
1607 MDCVII |
|||
1708 MDCCVIII |
|||
1809 MDCCCIX |
|||
1910 MCMX |
|||
2011 MMXI |
|||
10000 (X) |
|||
100000 (C) |
|||
1000000 (M) |
|||
10000000 ((X)) |
|||
100000000 ((C)) |
|||
1000000000 ((M)) |
|||
10000000000 (((X))) |
|||
100000000000 (((C))) |
|||
1000000000000 (((M))) |
|||
10000000000000 ((((X)))) |
|||
100000000000000 ((((C)))) |
|||
1000000000000000 ((((M)))) |
|||
10000000000000000 (((((X))))) |
|||
100000000000000000 (((((C))))) |
|||
1000000000000000000 (((((M))))) |
|||
10000000000000000000 ((((((X)))))) |
|||
100000000000000000000 ((((((C)))))) |
|||
1000000000000000000000 ((((((M)))))) |
|||
10000000000000000000000 (((((((X))))))) |
|||
100000000000000000000000 (((((((C))))))) |
|||
1000000000000000000000000 (((((((M))))))) |
|||
10000000000000000000000000 ((((((((X)))))))) |
|||
100000000000000000000000000 ((((((((C)))))))) |
|||
1000000000000000000000000000 ((((((((M)))))))) |
|||
10000000000000000000000000000 (((((((((X))))))))) |
|||
100000000000000000000000000000 (((((((((C))))))))) |
|||
1000000000000000000000000000000 (((((((((M))))))))) |
|||
10000000000000000000000000000000 ((((((((((X)))))))))) |
|||
100000000000000000000000000000000 ((((((((((C)))))))))) |
|||
1000000000000000000000000000000000 ((((((((((M)))))))))) |
|||
10000000000000000000000000000000000 (((((((((((X))))))))))) |
|||
100000000000000000000000000000000000 (((((((((((C))))))))))) |
|||
1000000000000000000000000000000000000 (((((((((((M))))))))))) |
|||
10000000000000000000000000000000000000 ((((((((((((X)))))))))))) |
|||
100000000000000000000000000000000000000 ((((((((((((C)))))))))))) |
|||
1000000000000000000000000000000000000000 ((((((((((((M)))))))))))) |
|||
10000000000000000000000000000000000000000 (((((((((((((X))))))))))))) |
|||
100000000000000000000000000000000000000000 (((((((((((((C))))))))))))) |
|||
1000000000000000000000000000000000000000000 (((((((((((((M))))))))))))) |
|||
10000000000000000000000000000000000000000000 ((((((((((((((X)))))))))))))) |
|||
100000000000000000000000000000000000000000000 ((((((((((((((C)))))))))))))) |
|||
1000000000000000000000000000000000000000000000 ((((((((((((((M)))))))))))))) |
|||
10000000000000000000000000000000000000000000000 (((((((((((((((X))))))))))))))) |
|||
100000000000000000000000000000000000000000000000 (((((((((((((((C))))))))))))))) |
|||
1000000000000000000000000000000000000000000000000 (((((((((((((((M))))))))))))))) |
|||
10000000000000000000000000000000000000000000000000 ((((((((((((((((X)))))))))))))))) |
|||
100000000000000000000000000000000000000000000000000 ((((((((((((((((C)))))))))))))))) |
|||
</pre> |
|||
=={{header|Ring}}== |
|||
<syntaxhighlight lang="ring"> |
|||
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"] |
|||
see "2009 = " + toRoman(2009) + nl |
|||
see "1666 = " + toRoman(1666) + nl |
|||
see "3888 = " + toRoman(3888) + nl |
|||
func toRoman val |
|||
result = "" |
|||
for i = 1 to 13 |
|||
while val >= arabic[i] |
|||
result = result + roman[i] |
|||
val = val - arabic[i] |
|||
end |
|||
next |
|||
return result |
|||
</syntaxhighlight> |
|||
=={{header|RPL}}== |
|||
{{trans|Python}} |
|||
{{works with|Halcyon Calc|4.2.7}} |
|||
{| class="wikitable" |
|||
! RPL code |
|||
! Comment |
|||
|- |
|||
| |
|||
≪ { 1000 900 500 400 100 90 50 40 10 9 5 4 1 } |
|||
{ "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" |
|||
"V" "IV" "I" } → divs rdig |
|||
'''IF''' DUP 5000 < '''THEN''' |
|||
"" SWAP 1 13 '''FOR''' j |
|||
divs j GET MOD LAST / IP ROT SWAP |
|||
'''WHILE''' DUP '''REPEAT''' |
|||
rdig j GET ROT SWAP + SWAP 1 - '''END''' |
|||
DROP SWAP |
|||
'''NEXT''' |
|||
'''END''' DROP |
|||
≫ ''''→ROM'''' STO |
|||
| |
|||
'''→ROM''' ''( n -- "ROMAN" )'' |
|||
store tables |
|||
if n < 5000 then |
|||
scan divisors |
|||
x,y = divmod(n, divisor) |
|||
if x > 0 then |
|||
add related digit x times |
|||
n = y |
|||
clean stack |
|||
|} |
|||
===Alternate version=== |
|||
{| class="wikitable" |
|||
! RPL code |
|||
! Comment |
|||
|- |
|||
| |
|||
≪ '''IF''' DUP 5000 < '''THEN''' |
|||
{ "IIIVIIIX" "XXXLXXXC" "CCCDCCCM" } |
|||
{ 11 21 31 43 44 54 64 74 87 88 } → rom args |
|||
≪ "" SWAP |
|||
1 3 '''FOR''' j |
|||
10 MOD LAST / IP |
|||
'''IF''' SWAP '''THEN''' |
|||
args LAST GET 10 MOD LAST / IP |
|||
rom j GET ROT ROT SUB ROT + SWAP '''END''' |
|||
'''NEXT''' ≫ |
|||
'''WHILE''' DUP '''REPEAT''' 1 - "M" ROT + SWAP '''END''' |
|||
DROP '''END''' |
|||
≫ ''''→ROM'''' STO |
|||
| |
|||
'''→ROM''' ''( n -- "M..CXVI" ) '' |
|||
collapsed Roman digits |
|||
10 arguments to extract Roman digits |
|||
initialize stack |
|||
process units to hundreds |
|||
divmod(n,10) |
|||
if last digit ≠ 0 then |
|||
get extraction arguments |
|||
extract Roman digit |
|||
add thousands if any |
|||
clean stack |
|||
|} |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |
||
Roman numeral generation was used as an example for demonstrating [http://www.xpsd.org/cgi-bin/wiki?TestDrivenDevelopmentTutorialRomanNumerals Test Driven Development] in Ruby. The solution came to be: |
Roman numeral generation was used as an example for demonstrating [http://www.xpsd.org/cgi-bin/wiki?TestDrivenDevelopmentTutorialRomanNumerals Test Driven Development] in Ruby. The solution came to be: |
||
< |
<syntaxhighlight lang="ruby">Symbols = { 1=>'I', 5=>'V', 10=>'X', 50=>'L', 100=>'C', 500=>'D', 1000=>'M' } |
||
Subtractors = [ [1000, 100], [500, 100], [100, 10], [50, 10], [10, 1], [5, 1], [1, 0] ] |
Subtractors = [ [1000, 100], [500, 100], [100, 10], [50, 10], [10, 1], [5, 1], [1, 0] ] |
||
Line 908: | Line 6,977: | ||
return roman(subtractor) + roman(num + subtractor) if num >= cutPoint - subtractor and num < cutPoint |
return roman(subtractor) + roman(num + subtractor) if num >= cutPoint - subtractor and num < cutPoint |
||
end |
end |
||
end |
end |
||
[1990, 2008, 1666].each do |i| |
|||
puts "%4d => %s" % [i, roman(i)] |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 => MCMXC |
|||
2008 => MMVIII |
|||
1666 => MDCLXVI |
|||
</pre> |
|||
Another shorter version if we don't consider calculating the substractors: |
|||
<syntaxhighlight lang="ruby"> |
|||
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 arabic_to_roman(arabic) |
|||
return '' if arabic.zero? |
|||
Symbols.each { |arabic_rep, roman_rep| return roman_rep + arabic_to_roman(arabic - arabic_rep) if arabic >= arabic_rep } |
|||
end |
|||
</syntaxhighlight> |
|||
Yet another way to solve it in terms of reduce |
|||
<syntaxhighlight lang="ruby"> |
|||
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 to_roman(num) |
|||
Symbols.reduce "" do |memo, (divisor, letter)| |
|||
div, num = num.divmod(divisor) |
|||
memo + letter * div |
|||
end |
|||
end |
|||
</syntaxhighlight> |
|||
=={{header|Rust}}== |
|||
<syntaxhighlight lang="rust">struct RomanNumeral { |
|||
symbol: &'static str, |
|||
value: u32 |
|||
} |
|||
const NUMERALS: [RomanNumeral; 13] = [ |
|||
RomanNumeral {symbol: "M", value: 1000}, |
|||
RomanNumeral {symbol: "CM", value: 900}, |
|||
RomanNumeral {symbol: "D", value: 500}, |
|||
RomanNumeral {symbol: "CD", value: 400}, |
|||
RomanNumeral {symbol: "C", value: 100}, |
|||
RomanNumeral {symbol: "XC", value: 90}, |
|||
RomanNumeral {symbol: "L", value: 50}, |
|||
RomanNumeral {symbol: "XL", value: 40}, |
|||
RomanNumeral {symbol: "X", value: 10}, |
|||
RomanNumeral {symbol: "IX", value: 9}, |
|||
RomanNumeral {symbol: "V", value: 5}, |
|||
RomanNumeral {symbol: "IV", value: 4}, |
|||
RomanNumeral {symbol: "I", value: 1} |
|||
]; |
|||
fn to_roman(mut number: u32) -> String { |
|||
let mut min_numeral = String::new(); |
|||
for numeral in NUMERALS.iter() { |
|||
while numeral.value <= number { |
|||
min_numeral = min_numeral + numeral.symbol; |
|||
number -= numeral.value; |
|||
} |
|||
} |
|||
min_numeral |
|||
} |
|||
fn main() { |
|||
let nums = [2014, 1999, 25, 1666, 3888]; |
|||
for &n in nums.iter() { |
|||
// 4 is minimum printing width, for alignment |
|||
println!("{:2$} = {}", n, to_roman(n), 4); |
|||
} |
|||
}</syntaxhighlight>{{out}} |
|||
<pre> |
|||
2014 = MMXIV |
|||
1999 = MCMXCIX |
|||
25 = XXV |
|||
1666 = MDCLXVI |
|||
3888 = MMMDCCCLXXXVIII |
|||
</pre> |
|||
=={{header|Scala}}== |
|||
{{works with|Scala|2.8}} |
|||
<syntaxhighlight lang="scala">val romanDigits = Map( |
|||
1 -> "I", 5 -> "V", |
|||
10 -> "X", 50 -> "L", |
|||
100 -> "C", 500 -> "D", |
|||
1000 -> "M", |
|||
4 -> "IV", 9 -> "IX", |
|||
40 -> "XL", 90 -> "XC", |
|||
400 -> "CD", 900 -> "CM") |
|||
val romanDigitsKeys = romanDigits.keysIterator.toList sortBy (x => -x) |
|||
def toRoman(n: Int): String = romanDigitsKeys find (_ >= n) match { |
|||
case Some(key) => romanDigits(key) + toRoman(n - key) |
|||
case None => "" |
|||
}</syntaxhighlight> |
|||
{{Out}} |
|||
<pre>scala> List(1990, 2008, 1666) map toRoman |
|||
res55: List[String] = List(MCMXC, MMVIII, MDCLXVI)</pre> |
|||
===Using foldLeft=== |
|||
<syntaxhighlight lang="scala">def toRoman( v:Int ) : String = { |
|||
val romanNumerals = List(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") |
|||
var n = v |
|||
romanNumerals.foldLeft(""){(s,t) => {val c = n/t._1; n = n-t._1*c; s + (t._2 * c) } } |
|||
} |
|||
// A small test |
|||
def test( arabic:Int ) = println( arabic + " => " + toRoman( arabic ) ) |
|||
test(1990) |
|||
test(2008) |
|||
test(1666)</syntaxhighlight> |
|||
===Different code-style=== |
|||
<syntaxhighlight lang="scala">def toRoman(num: Int): String = { |
|||
case class RomanUnit(value: Int, token: String) |
|||
val romanNumerals = List( |
|||
RomanUnit(1000, "M"), |
|||
RomanUnit(900, "CM"), |
|||
RomanUnit(500, "D"), |
|||
RomanUnit(400, "CD"), |
|||
RomanUnit(100, "C"), |
|||
RomanUnit(90, "XC"), |
|||
RomanUnit(50, "L"), |
|||
RomanUnit(40, "XL"), |
|||
RomanUnit(10, "X"), |
|||
RomanUnit(9, "IX"), |
|||
RomanUnit(5, "V"), |
|||
RomanUnit(4, "IV"), |
|||
RomanUnit(1, "I")) |
|||
var remainingNumber = num |
|||
romanNumerals.foldLeft("") { (outputStr, romanUnit) => |
|||
{ |
|||
val times = remainingNumber / romanUnit.value |
|||
remainingNumber -= romanUnit.value * times |
|||
outputStr + (romanUnit.token * times) |
|||
} |
|||
} |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990 => MCMXC |
|||
2008 => MMVIII |
|||
1666 => MDCLXVI</pre> |
|||
=={{header|Scheme}}== |
=={{header|Scheme}}== |
||
This uses format directives supported in Chez Scheme since v6.9b; YMMV. |
This uses format directives supported in Chez Scheme since v6.9b; YMMV. |
||
<syntaxhighlight lang="scheme">(define (to-roman n) |
|||
<lang scheme> |
|||
(format "~@r" n))</syntaxhighlight> |
|||
(define (to-roman n) |
|||
(format "~@r" n)) |
|||
This is a general example using Chicken Scheme. |
|||
</lang> |
|||
<syntaxhighlight lang="scheme">(define roman-decimal |
|||
'(("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))) |
|||
(define (to-roman value) |
|||
(apply string-append |
|||
(let loop ((v value) |
|||
(decode roman-decimal)) |
|||
(let ((r (caar decode)) |
|||
(d (cdar decode))) |
|||
(cond |
|||
((= v 0) '()) |
|||
((>= v d) (cons r (loop (- v d) decode))) |
|||
(else (loop v (cdr decode)))))))) |
|||
(let loop ((n '(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))) |
|||
(unless (null? n) |
|||
(printf "~a ~a\n" (car n) (to-roman (car n))) |
|||
(loop (cdr n)))) |
|||
</syntaxhighlight> |
|||
=={{header|Seed7}}== |
|||
The following program writes the numbers between 1 and 3999 as roman numerals. |
|||
The [http://seed7.sourceforge.net/libraries/wrinum.htm wrinum.s7i] library contains the |
|||
function [http://seed7.sourceforge.net/libraries/wrinum.htm#str%28ROMAN,in_integer%29 str(ROMAN,)], |
|||
which writes a roman numeral to a string. |
|||
<syntaxhighlight lang="seed7">$ include "seed7_05.s7i"; |
|||
include "stdio.s7i"; |
|||
include "wrinum.s7i"; |
|||
const proc: main is func |
|||
local |
|||
var integer: number is 0; |
|||
begin |
|||
for number range 1 to 3999 do |
|||
writeln(str(ROMAN, number)); |
|||
end for; |
|||
end func;</syntaxhighlight> |
|||
Original source [http://seed7.sourceforge.net/algorith/puzzles.htm#roman_numerals]. |
|||
=={{header|SenseTalk}}== |
|||
<syntaxhighlight lang="sensetalk">function RomanNumeralsEncode number |
|||
put [ |
|||
(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") |
|||
] into values |
|||
repeat for index = each item of (the number of items in values)..1 |
|||
put item index of values into pair |
|||
repeat while number is greater than or equal to the first item of pair |
|||
put the second item of pair after numerals |
|||
subtract the first item of pair from number |
|||
end repeat |
|||
end repeat |
|||
return numerals |
|||
end RomanNumeralsEncode</syntaxhighlight> |
|||
<syntaxhighlight lang="sensetalk">repeat for each item in [ |
|||
1990, |
|||
2008, |
|||
1666 |
|||
] |
|||
put RomanNumeralsEncode(it) |
|||
end repeat</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMVIII |
|||
MDCLXVI |
|||
</pre> |
|||
=={{header|SETL}}== |
|||
<syntaxhighlight lang="ada">examples := [2008, 1666, 1990]; |
|||
for example in examples loop |
|||
print( roman_numeral(example) ); |
|||
end loop; |
|||
proc roman_numeral( n ); |
|||
R := [[1000, 'M'], [900, 'CM'], [500, 'D'], [400, 'CD'], [100, 'C'], [90, 'XC'], [50, 'L'], [40, 'XL'], [10, 'X'], [9, 'IX'], [5, 'V'], [4, 'IV'], [1, 'I']]; |
|||
roman := ''; |
|||
for numeral in R loop |
|||
while n >= numeral(1) loop |
|||
n := n - numeral(1); |
|||
roman := roman + numeral(2); |
|||
end loop; |
|||
end loop; |
|||
return roman; |
|||
end;</syntaxhighlight> |
|||
{{out}} |
|||
<pre>MMVIII |
|||
MDCLXVI |
|||
MCMXC</pre> |
|||
=={{header|Shen}}== |
|||
<syntaxhighlight lang="shen"> |
|||
(define encodeGlyphs |
|||
ACC 0 _ -> ACC |
|||
ACC N [Glyph Value | Rest] -> (encodeGlyphs (@s ACC Glyph) (- N Value) [Glyph Value | Rest]) where (>= N Value) |
|||
ACC N [Glyph Value | Rest] -> (encodeGlyphs ACC N Rest) |
|||
) |
|||
(define encodeRoman |
|||
N -> (encodeGlyphs "" N ["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]) |
|||
) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
(4-) (encodeRoman 1990) |
|||
"MCMXC" |
|||
(5-) (encodeRoman 2008) |
|||
"MMVIII" |
|||
(6-) (encodeRoman 1666) |
|||
"MDCLXVI" |
|||
</pre> |
|||
=={{header|Sidef}}== |
|||
{{trans|ActionScript}} |
|||
<syntaxhighlight lang="ruby">func arabic2roman(num, roman='') { |
|||
static lookup = [ |
|||
: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 |
|||
]; |
|||
lookup.each { |pair| |
|||
while (num >= pair.second) { |
|||
roman += pair.first; |
|||
num -= pair.second; |
|||
} |
|||
} |
|||
return roman; |
|||
} |
|||
say("1990 in roman is " + arabic2roman(1990)); |
|||
say("2008 in roman is " + arabic2roman(2008)); |
|||
say("1666 in roman is " + arabic2roman(1666));</syntaxhighlight> |
|||
{{out}} |
|||
<pre>1990 in roman is MCMXC |
|||
2008 in roman is MMVIII |
|||
1666 in roman is MDCLXVI</pre> |
|||
=={{header|Simula}}== |
|||
<syntaxhighlight lang="simula">BEGIN |
|||
TEXT PROCEDURE TOROMAN(N); INTEGER N; |
|||
BEGIN |
|||
PROCEDURE P(WEIGHT,LIT); INTEGER WEIGHT; TEXT LIT; |
|||
BEGIN |
|||
WHILE N >= WEIGHT DO |
|||
BEGIN |
|||
T :- T & LIT; |
|||
N := N - WEIGHT; |
|||
END WHILE; |
|||
END P; |
|||
TEXT T; T :- NOTEXT; |
|||
P( 1000, "M" ); |
|||
P( 900, "CM" ); |
|||
P( 500, "D" ); |
|||
P( 400, "CD" ); |
|||
P( 100, "C" ); |
|||
P( 90, "XC" ); |
|||
P( 50, "L" ); |
|||
P( 40, "XL" ); |
|||
P( 10, "X" ); |
|||
P( 9, "IX" ); |
|||
P( 5, "V" ); |
|||
P( 4, "IV" ); |
|||
P( 1, "I" ); |
|||
TOROMAN :- T; |
|||
END TOROMAN; |
|||
INTEGER Y; |
|||
FOR Y := 1990, 2008, 1666 DO |
|||
BEGIN |
|||
OUTTEXT("YEAR "); |
|||
OUTINT(Y, 4); |
|||
OUTTEXT(" => "); |
|||
OUTTEXT(TOROMAN(Y)); |
|||
OUTIMAGE; |
|||
END FOR; |
|||
END PROGRAM; |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
YEAR 1990 => MCMXC |
|||
YEAR 2008 => MMVIII |
|||
YEAR 1666 => MDCLXVI |
|||
</pre> |
|||
=={{header|Smalltalk}}== |
|||
{{works with|Smalltalk/X}} |
|||
in ST/X, integers already know how to print themselves as roman number: |
|||
<syntaxhighlight lang="smalltalk">2013 printRomanOn:Stdout naive:false</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MMXIII</pre> |
|||
the implementation is: |
|||
<syntaxhighlight lang="smalltalk"> |
|||
printRomanOn:aStream naive:naive |
|||
"print the receiver as roman number to the argument, aStream. |
|||
The naive argument controls if the conversion is |
|||
correct (i.e. subtracting prefix notation for 4,9,40,90, etc.), |
|||
or naive (i.e. print 4 as IIII and 9 as VIIII); also called simple. |
|||
The naive version is often used for page numbers in documents." |
|||
|restValue spec| |
|||
restValue := self. |
|||
restValue > 0 ifFalse:[self error:'negative roman']. |
|||
naive ifTrue:[ |
|||
spec := #( |
|||
" value string repeat " |
|||
1000 'M' true |
|||
500 'D' false |
|||
100 'C' true |
|||
50 'L' false |
|||
10 'X' true |
|||
5 'V' false |
|||
1 'I' true |
|||
). |
|||
] ifFalse:[ |
|||
spec := #( |
|||
" value string repeat " |
|||
1000 'M' true |
|||
900 'CM' false |
|||
500 'D' false |
|||
400 'CD' false |
|||
100 'C' true |
|||
90 'XC' false |
|||
50 'L' false |
|||
40 'XL' false |
|||
10 'X' true |
|||
9 'IX' false |
|||
5 'V' false |
|||
4 'IV' false |
|||
1 'I' true |
|||
). |
|||
]. |
|||
spec |
|||
inGroupsOf:3 |
|||
do:[:rValue :rString :repeatFlag | |
|||
[ |
|||
(restValue >= rValue) ifTrue:[ |
|||
aStream nextPutAll:rString. |
|||
restValue := restValue - rValue. |
|||
]. |
|||
] doWhile:[ repeatFlag and:[ restValue >= rValue] ]. |
|||
]. |
|||
</syntaxhighlight> |
|||
=={{header|SNOBOL4}}== |
|||
Adapted from [http://burks.bton.ac.uk/burks/language/snobol/catspaw/tutorial/ch6.htm Catspaw SNOBOL Tutorial, Chapter 6] |
|||
<syntaxhighlight lang="snobol4"> |
|||
* ROMAN(N) - Convert integer N to Roman numeral form. |
|||
* |
|||
* N must be positive and less than 4000. |
|||
* |
|||
* An asterisk appears in the result if N >= 4000. |
|||
* |
|||
* The function fails if N is not an integer. |
|||
DEFINE('ROMAN(N)UNITS') :(ROMAN_END) |
|||
* Get rightmost digit to UNITS and remove it from N. |
|||
* Return null result if argument is null. |
|||
ROMAN N RPOS(1) LEN(1) . UNITS = :F(RETURN) |
|||
* Search for digit, replace with its Roman form. |
|||
* Return failing if not a digit. |
|||
'0,1I,2II,3III,4IV,5V,6VI,7VII,8VIII,9IX,' UNITS |
|||
+ BREAK(',') . UNITS :F(FRETURN) |
|||
* Convert rest of N and multiply by 10. Propagate a |
|||
* failure return from recursive call back to caller. |
|||
ROMAN = REPLACE(ROMAN(N), 'IVXLCDM', 'XLCDM**') |
|||
+ UNITS :S(RETURN) F(FRETURN) |
|||
ROMAN_END |
|||
* Testing |
|||
OUTPUT = "1999 = " ROMAN(1999) |
|||
OUTPUT = " 24 = " ROMAN(24) |
|||
OUTPUT = " 944 = " ROMAN(944) |
|||
END</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1999 = MCMXCIX |
|||
24 = XXIV |
|||
944 = CMXLIV |
|||
</pre> |
|||
Here's a non-recursive version, and a Roman-to-Arabic converter to boot. |
|||
<syntaxhighlight lang="snobol4">* # Arabic to Roman |
|||
define('roman(n)s,ch,val,str') :(roman_end) |
|||
roman roman = ge(n,4000) n :s(return) |
|||
s = 'M1000 CM900 D500 CD400 C100 XC90 L50 XL40 X10 IX9 V5 IV4 I1 ' |
|||
rom1 s span(&ucase) . ch break(' ') . val span(' ') = :f(rom2) |
|||
str = str dupl(ch,(n / val)) |
|||
n = remdr(n,val) :(rom1) |
|||
rom2 roman = str :(return) |
|||
roman_end |
|||
* # Roman to Arabic |
|||
define('arabic(n)s,ch,val,sum,x') :(arabic_end) |
|||
arabic s = 'M1000 D500 C100 L50 X10 V5 I1 ' |
|||
n = reverse(n) |
|||
arab1 n len(1) . ch = :f(arab2) |
|||
s ch break(' ') . val |
|||
val = lt(val,x) (-1 * val) |
|||
sum = sum + val; x = val :(arab1) |
|||
arab2 arabic = sum :(return) |
|||
arabic_end |
|||
* # Test and display |
|||
tstr = '2010 1999 1492 1066 476 ' |
|||
tloop tstr break(' ') . year span(' ') = :f(out) |
|||
r = roman(year) |
|||
rstr = rstr year '=' r ' ' |
|||
astr = astr r '=' arabic(r) ' ' :(tloop) |
|||
out output = rstr; output = astr |
|||
end</syntaxhighlight> |
|||
{{out}} |
|||
<pre>2010=MMX 1999=MCMXCIX 1492=MCDXCII 1066=MLXVI 476=CDLXXVI |
|||
MMX=2010 MCMXCIX=1999 MCDXCII=1492 MLXVI=1066 CDLXXVI=476</pre> |
|||
=={{header|SPL}}== |
|||
<syntaxhighlight lang="spl">a2r(a)= |
|||
r = "" |
|||
n = [["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]] |
|||
> i, 1..13 |
|||
> a!<n[i,2] |
|||
r += n[i,1] |
|||
a -= n[i,2] |
|||
< |
|||
< |
|||
<= r |
|||
. |
|||
t = [1990,2008,1666] |
|||
> i, 1..#.size(t,1) |
|||
#.output(t[i]," = ",a2r(t[i])) |
|||
<</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990 = MCMXC |
|||
2008 = MMVIII |
|||
1666 = MDCLXVI |
|||
</pre> |
|||
=={{header|SQL}}== |
|||
<syntaxhighlight lang="sql"> |
|||
-- |
|||
-- This only works under Oracle and has the limitation of 1 to 3999 |
|||
SQL> select to_char(1666, 'RN') urcoman, to_char(1666, 'rn') lcroman from dual; |
|||
URCOMAN LCROMAN |
|||
--------------- --------------- |
|||
MDCLXVI mdclxvi |
|||
</syntaxhighlight> |
|||
=={{header|Swift}}== |
|||
<syntaxhighlight lang="swift">func ator(var n: Int) -> String { |
|||
var result = "" |
|||
for (value, letter) in |
|||
[( 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")] |
|||
{ |
|||
while n >= value { |
|||
result += letter |
|||
n -= value |
|||
} |
|||
} |
|||
return result |
|||
}</syntaxhighlight> |
|||
Sample call: |
|||
{{works with|Swift|1.x}} |
|||
<syntaxhighlight lang="swift">println(ator(1666)) // MDCLXVI</syntaxhighlight> |
|||
{{works with|Swift|2.0}} |
|||
<syntaxhighlight lang="swift">print(ator(1666)) // MDCLXVI</syntaxhighlight> |
|||
{{output}} |
|||
<pre>MDCLXVI </pre> |
|||
=={{header|Tailspin}}== |
|||
<syntaxhighlight lang="tailspin"> |
|||
def digits: [(M:1000"1"), (CM:900"1"), (D:500"1"), (CD:400"1"), (C:100"1"), (XC:90"1"), (L:50"1"), (XL:40"1"), (X:10"1"), (IX:9"1"), (V:5"1"), (IV:4"1"), (I:1"1")]; |
|||
templates encodeRoman |
|||
@: 1; |
|||
'$ -> ($)"1" -> #;' ! |
|||
when <$digits($@)::value..> do |
|||
$digits($@)::key ! |
|||
$ - $digits($@)::value -> # |
|||
when <1"1"..> do |
|||
@:$@ + 1; |
|||
$ -> # |
|||
end encodeRoman |
|||
1990 -> encodeRoman -> !OUT::write |
|||
' |
|||
' -> !OUT::write |
|||
2008 -> encodeRoman -> !OUT::write |
|||
' |
|||
' -> !OUT::write |
|||
1666 -> encodeRoman -> !OUT::write |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMVIII |
|||
MDCLXVI |
|||
</pre> |
|||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
< |
<syntaxhighlight lang="tcl">proc to_roman {i} { |
||
set 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} |
set 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} |
||
foreach {value roman} $map { |
foreach {value roman} $map { |
||
Line 928: | Line 7,612: | ||
} |
} |
||
return $res |
return $res |
||
}</ |
}</syntaxhighlight> |
||
=={{header|TUSCRIPT}}== |
|||
<syntaxhighlight lang="tuscript"> |
|||
$$ MODE TUSCRIPT |
|||
LOOP arab_number="1990'2008'1666" |
|||
roman_number = ENCODE (arab_number,ROMAN) |
|||
PRINT "Arabic number ",arab_number, " equals ", roman_number |
|||
ENDLOOP |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Arabic number 1990 equals MCMXC |
|||
Arabic number 2008 equals MMVIII |
|||
Arabic number 1666 equals MDCLXVI |
|||
</pre> |
|||
== {{header|TypeScript}} == |
|||
{{trans|DWScript}} |
|||
Weights and symbols in tuples. |
|||
<syntaxhighlight lang="javascript"> |
|||
// Roman numerals/Encode |
|||
const weightsSymbols: [number, 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']]; |
|||
// 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded |
|||
// with these symbols. |
|||
function toRoman(n: number): string { |
|||
var roman = ""; // Result |
|||
for (i = 0; i <= 12 && n > 0; i++) { |
|||
var w = weightsSymbols[i][0]; |
|||
while (n >= w) { |
|||
roman += weightsSymbols[i][1]; |
|||
n -= w; |
|||
} |
|||
} |
|||
return roman; |
|||
} |
|||
console.log(toRoman(1990)); // MCMXC |
|||
console.log(toRoman(2022)); // MMXXII |
|||
console.log(toRoman(3888)); // MMMDCCCLXXXVIII |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMXXII |
|||
MMMDCCCLXXXVIII |
|||
</pre> |
|||
=={{header|UNIX Shell}}== |
|||
{{trans|Tcl}} |
|||
{{works with|bash}} |
|||
<syntaxhighlight lang="bash">roman() { |
|||
local values=( 1000 900 500 400 100 90 50 40 10 9 5 4 1 ) |
|||
local roman=( |
|||
[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 |
|||
) |
|||
local nvmber="" |
|||
local num=$1 |
|||
for value in ${values[@]}; do |
|||
while (( num >= value )); do |
|||
nvmber+=${roman[value]} |
|||
((num -= value)) |
|||
done |
|||
done |
|||
echo $nvmber |
|||
} |
|||
for test in 1999 24 944 1666 2008; do |
|||
printf "%d = %s\n" $test $(roman $test) |
|||
done</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1999 = MCMXCIX |
|||
24 = XXIV |
|||
944 = CMXLIV |
|||
1666 = MDCLXVI |
|||
2008 = MMVIII</pre> |
|||
=={{header|Ursala}}== |
=={{header|Ursala}}== |
||
Line 939: | Line 7,706: | ||
CCCC are replaced by CD. The substitution operator (%=) is helpful |
CCCC are replaced by CD. The substitution operator (%=) is helpful |
||
here. |
here. |
||
< |
<syntaxhighlight lang="ursala">#import nat |
||
roman = |
roman = |
||
Line 945: | Line 7,712: | ||
-+ |
-+ |
||
'IIII'%='IV'+ 'VIIII'%='IX'+ 'XXXX'%='XL'+ 'LXXXX'%='XC'+ 'CCCC'%='CD'+ 'DCCCC'%='CM', |
'IIII'%='IV'+ 'VIIII'%='IX'+ 'XXXX'%='XL'+ 'LXXXX'%='XC'+ 'CCCC'%='CD'+ 'DCCCC'%='CM', |
||
~&plrDlSPSL/'MDCLXVI'+ iota*+ +^|(^|C/~&,\/division)@rlX=>~&iNC <1000,500,100,50,10,5>+-</ |
~&plrDlSPSL/'MDCLXVI'+ iota*+ +^|(^|C/~&,\/division)@rlX=>~&iNC <1000,500,100,50,10,5>+-</syntaxhighlight> |
||
This test program applies the function to each member of a list of numbers. |
This test program applies the function to each member of a list of numbers. |
||
< |
<syntaxhighlight lang="ursala">#show+ |
||
test = roman* <1990,2008,1,2,64,124,1666,10001></ |
test = roman* <1990,2008,1,2,64,124,1666,10001></syntaxhighlight> |
||
{{out}} |
|||
output: |
|||
<pre>MCMXC |
<pre>MCMXC |
||
MMVIII |
MMVIII |
||
Line 959: | Line 7,726: | ||
MDCLXVI |
MDCLXVI |
||
MMMMMMMMMMI</pre> |
MMMMMMMMMMI</pre> |
||
=={{header|Vala}}== |
|||
{{trans|D}} |
|||
<syntaxhighlight lang="vala">string to_roman(int n) |
|||
requires (n > 0 && n < 5000) |
|||
{ |
|||
const int[] weights = {1000, 900, 500, 400, 100, 90, |
|||
50, 40, 10, 9, 5, 4, 1}; |
|||
const string[] symbols = {"M","CM","D","CD","C","XC","L", |
|||
"XL","X","IX","V","IV","I"}; |
|||
var roman = "", count = 0; |
|||
foreach (var w in weights) { |
|||
while (n >= w) { |
|||
roman += symbols[count]; |
|||
n -= w; |
|||
} |
|||
if (n == 0) |
|||
break; |
|||
count++; |
|||
} |
|||
return roman; |
|||
} |
|||
void main() { |
|||
print("%s\n", to_roman(455)); |
|||
print("%s\n", to_roman(3456)); |
|||
print("%s\n", to_roman(2488)); |
|||
}</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
CDLV |
|||
MMMCDLVI |
|||
MMCDLXXXVIII |
|||
</pre> |
|||
=={{header|VBA}}== |
|||
<syntaxhighlight lang="vb">Private Function roman(n As Integer) As String |
|||
roman = WorksheetFunction.roman(n) |
|||
End Function |
|||
Public Sub main() |
|||
s = [{10, 2016, 800, 2769, 1666, 476, 1453}] |
|||
For Each x In s |
|||
Debug.Print roman(CInt(x)); " "; |
|||
Next x |
|||
End Sub</syntaxhighlight>{{out}} |
|||
<pre>X MMXVI DCCC MMDCCLXIX MDCLXVI CDLXXVI MCDLIII </pre> |
|||
=={{header|Vedit macro language}}== |
=={{header|Vedit macro language}}== |
||
<syntaxhighlight lang="vedit">// Main program for testing the function |
|||
<lang vedit> |
|||
// |
|||
do { |
do { |
||
#1 = Get_Num("Number to convert: ") |
#1 = Get_Num("Number to convert: ", STATLINE) |
||
Call(" |
Call("NUM_TO_ROMAN") |
||
Num_Type(#1, NOCR) Message(" = ") Reg_Type(1) Type_Newline |
|||
} while (Reg_Size(1)) |
} while (Reg_Size(1)) |
||
Return |
Return |
||
// Convert numeric value into Roman number |
// Convert numeric value into Roman number |
||
// #1 = number to convert; on return: T-reg(1) = Roman number |
// #1 = number to convert; on return: T-reg(1) = Roman number |
||
// |
// |
||
:NUM_TO_ROMAN: |
|||
:ROMAN_NUMBER: |
|||
Reg_Empty(1) // @1 = Results (Roman number) |
Reg_Empty(1) // @1 = Results (Roman number) |
||
if (#1 < 1) { Return } // non-positive numbers return empty string |
if (#1 < 1) { Return } // non-positive numbers return empty string |
||
Buf_Switch(Buf_Free) |
Buf_Switch(Buf_Free) |
||
Ins_Text("M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1") |
Ins_Text("M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1") |
||
BOF |
BOF |
||
#2 = #1 |
|||
Repeat(ALL) { |
Repeat(ALL) { |
||
Search("|A|[|A]", ADVANCE+ERRBREAK) // get next item from conversion list |
Search("|A|[|A]", ADVANCE+ERRBREAK) // get next item from conversion list |
||
Reg_Copy_Block(20, CP-Chars_Matched, CP) // @20 = Letter(s) to be inserted |
Reg_Copy_Block(20, CP-Chars_Matched, CP) // @20 = Letter(s) to be inserted |
||
#11 = Num_Eval() // #11 = magnitude (1000...1) |
#11 = Num_Eval() // #11 = magnitude (1000...1) |
||
while (# |
while (#2 >= #11) { |
||
Reg_Set(1, @20, APPEND) |
Reg_Set(1, @20, APPEND) |
||
# |
#2 -= #11 |
||
} |
} |
||
} |
} |
||
Buf_Quit(OK) |
Buf_Quit(OK) |
||
Return |
Return</syntaxhighlight> |
||
</lang> |
|||
{{out}} |
|||
<pre> 4 = IV |
|||
12 = XII |
|||
1666 = MDCLXVI |
|||
1990 = MCMXC |
|||
2011 = MMXI</pre> |
|||
=={{header|V (Vlang)}}== |
|||
<syntaxhighlight lang="Zig"> |
|||
const numerals = {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"} |
|||
fn main() { |
|||
println(encode(1990)) |
|||
println(encode(2008)) |
|||
println(encode(1666)) |
|||
} |
|||
fn encode(number int) string { |
|||
mut num := number |
|||
mut result := "" |
|||
if number < 1 || number > 5000 {return result} |
|||
for digit, roman in numerals { |
|||
for num >= digit { |
|||
num -= digit |
|||
result += roman |
|||
} |
|||
} |
|||
return result |
|||
} |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MMVIII |
|||
MDCLXVI |
|||
</pre> |
|||
=={{header|Wren}}== |
|||
{{trans|Kotlin}} |
|||
<syntaxhighlight lang="wren">var 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"] |
|||
] |
|||
var encode = Fn.new { |n| |
|||
if (n > 5000 || n < 1) return null |
|||
var res = "" |
|||
for (r in romans) { |
|||
while (n >= r[0]) { |
|||
n = n - r[0] |
|||
res = res + r[1] |
|||
} |
|||
} |
|||
return res |
|||
} |
|||
System.print(encode.call(1990)) |
|||
System.print(encode.call(1666)) |
|||
System.print(encode.call(2008)) |
|||
System.print(encode.call(2020))</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
MCMXC |
|||
MDCLXVI |
|||
MMVIII |
|||
MMXX |
|||
</pre> |
|||
=={{header|XLISP}}== |
|||
<syntaxhighlight lang="lisp">(defun roman (n) |
|||
(define roman-numerals '((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"))) |
|||
(defun romanize (arabic-numeral numerals roman-numeral) |
|||
(if (= arabic-numeral 0) |
|||
roman-numeral |
|||
(if (>= arabic-numeral (caar numerals)) |
|||
(romanize (- arabic-numeral (caar numerals)) numerals (string-append roman-numeral (cadar numerals))) |
|||
(romanize arabic-numeral (cdr numerals) roman-numeral)))) |
|||
(romanize n roman-numerals "")) |
|||
; test the function: |
|||
(display (mapcar roman '(10 2016 800 2769 1666 476 1453)))</syntaxhighlight> |
|||
{{out}} |
|||
<pre>(x mmxvi dccc mmdcclxix mdclxvi cdlxxvi mcdliii)</pre> |
|||
=={{header|XPL0}}== |
|||
<syntaxhighlight lang="xpl0">proc Rom(N, A, B, C); \Display 1..9 in Roman numerals |
|||
int N, A, B, C, I; |
|||
[case N of |
|||
9: [ChOut(0, C); ChOut(0, A)]; \XI |
|||
8,7,6,5:[ChOut(0, B); for I:= 1 to rem(N/5) do ChOut(0, C)]; \V |
|||
4: [ChOut(0, C); ChOut(0, B)] \IV |
|||
other for I:= 1 to N do ChOut(0, C); \I |
|||
]; |
|||
proc Roman(N); \Display N in Roman numerals |
|||
int N, Q; |
|||
[Q:= N/1000; N:= rem(0); \0..3999 |
|||
Rom(Q, ^?, ^?, ^M); |
|||
Q:= N/100; N:= rem(0); \0..999 |
|||
Rom(Q, ^M, ^D, ^C); |
|||
Q:= N/10; N:= rem(0); \0..99 |
|||
Rom(Q, ^C, ^L, ^X); |
|||
Rom(N, ^X, ^V, ^I); \0..9 |
|||
]; |
|||
int Tbl, I; |
|||
[Tbl:= [1990, 2008, 1666, 0, 1, 3999, 2020, 1234]; |
|||
for I:= 0 to 7 do |
|||
[IntOut(0, Tbl(I)); Text(0, ". "); Roman(Tbl(I)); CrLf(0)]; |
|||
]</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
1990. MCMXC |
|||
2008. MMVIII |
|||
1666. MDCLXVI |
|||
0. |
|||
1. I |
|||
3999. MMMCMXCIX |
|||
2020. MMXX |
|||
1234. MCCXXXIV |
|||
</pre> |
|||
=={{header|XSLT}}== |
|||
<syntaxhighlight lang="xslt"> |
|||
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> |
|||
<xsl:template match="/data/number"> |
|||
<xsl:call-template name="for"> |
|||
<xsl:with-param name="stop">13</xsl:with-param> |
|||
<xsl:with-param name="value"><xsl:value-of select="@value"></xsl:value-of></xsl:with-param> |
|||
</xsl:call-template> |
|||
</xsl:template> |
|||
<xsl:template name="for"> |
|||
<xsl:param name="start">1</xsl:param> |
|||
<xsl:param name="stop">1</xsl:param> |
|||
<xsl:param name="step">1</xsl:param> |
|||
<xsl:param name="value">1</xsl:param> |
|||
<xsl:text/> |
|||
<xsl:choose> |
|||
<xsl:when test="($value > /data/roman |
|||
/numeral[@pos=$start]/@value or $value = /data/roman |
|||
/numeral[@pos=$start]/@value) "> |
|||
<xsl:value-of select="/data/roman |
|||
/numeral[@pos=$start]/@letter"/> |
|||
<xsl:call-template name="for"> |
|||
<xsl:with-param name="stop"> |
|||
<xsl:value-of select="$stop"/> |
|||
</xsl:with-param> |
|||
<xsl:with-param name="start"> |
|||
<xsl:value-of select="$start"/> |
|||
</xsl:with-param> |
|||
<xsl:with-param name="value"> |
|||
<xsl:value-of select="$value - /data/roman/numeral[@pos=$start]/@value"/> |
|||
</xsl:with-param> |
|||
</xsl:call-template> |
|||
</xsl:when> |
|||
<xsl:otherwise> |
|||
<xsl:if test="$start < $stop"> |
|||
<xsl:call-template name="for"> |
|||
<xsl:with-param name="stop"> |
|||
<xsl:value-of select="$stop"/> |
|||
</xsl:with-param> |
|||
<xsl:with-param name="start"> |
|||
<xsl:value-of select="$start + $step"/> |
|||
</xsl:with-param> |
|||
<xsl:with-param name="value"> |
|||
<xsl:value-of select="$value"/> |
|||
</xsl:with-param> |
|||
</xsl:call-template> |
|||
</xsl:if> |
|||
</xsl:otherwise> |
|||
</xsl:choose> |
|||
</xsl:template> |
|||
</xsl:stylesheet> |
|||
</syntaxhighlight> |
|||
=={{header|zkl}}== |
|||
<syntaxhighlight lang="zkl">var [const] romans = L( |
|||
L("M", 1000), L("CM", 900), L("D", 500), L("CD", 400), L("C", 100), |
|||
L("XC", 90), L("L", 50), L("XL", 40), L("X", 10), L("IX", 9), |
|||
L("V", 5), L("IV", 4), L("I", 1)); |
|||
fcn toRoman(i){ // convert int to a roman number |
|||
reg text = ""; |
|||
foreach R,N in (romans){ text += R*(i/N); i = i%N; } |
|||
return(text); |
|||
}</syntaxhighlight> |
|||
<pre> |
|||
toRoman(1990) //-->"MCMXC" |
|||
toRoman(2008) //-->"MMVIII" |
|||
toRoman(1666) //-->"MDCLXVI" |
|||
</pre> |
|||
=={{header|Zoea}}== |
|||
<syntaxhighlight lang="zoea"> |
|||
program: decimal_roman |
|||
input: 12 |
|||
output: 'XII' |
|||
</syntaxhighlight> |
|||
=={{header|Zoea Visual}}== |
|||
[http://zoea.co.uk/examples/zv-rc/Roman_numerals_encode.png Roman numerals encode] |
|||
=={{header|Zsh}}== |
|||
Based on the python solution. |
|||
<syntaxhighlight lang="zsh">function printroman () { |
|||
local -a conv |
|||
local number=$1 div rom num out |
|||
conv=(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) |
|||
for num rom in ${(Oa)conv}; do |
|||
(( div = number / num, number = number % num )) |
|||
while (( div-- > 0 )); do |
|||
out+=$rom |
|||
done |
|||
done |
|||
echo $out |
|||
}</syntaxhighlight> |
Latest revision as of 20:58, 7 July 2024
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
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
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))
360 Assembly
* Roman numerals Encode - 11/05/2020
ROMAENC CSECT
USING ROMAENC,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A(8)) do i=1 to hbound(nums)
LR R1,R6 i
SLA R1,1 ~
LH R8,NUMS-2(R1) n=nums(i)
MVC PG,=CL80'.... :' clear buffer
LA R9,PG @pg
XDECO R8,XDEC edit n
MVC 0(4,R9),XDEC+8 output n
LA R9,7(R9) @pg+=7
LA R7,1 j=1
DO WHILE=(C,R7,LE,=A(13)) do j=1 to 13
LR R1,R7 j
SLA R1,1 ~
LH R3,ARABIC-2(R1) aj=arabic(j)
DO WHILE=(CR,R8,GE,R3) while n>=aj
LR R1,R7 j
SLA R1,1 ~
LA R4,ROMAN-2(R1) roman(j)
MVC 0(2,R9),0(R4) output roman(j)
IF CLI,1(R9),NE,C' ' THEN if roman(j)[2]=' ' then
LA R9,2(R9) @pg+=2
ELSE , else
LA R9,1(R9) @pg+=1
ENDIF , endif
SR R8,R3 n-=aj
ENDDO , endwile
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print buffer
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling save
ARABIC DC H'1000',H'900',H'500',H'400',H'100',H'90'
DC H'50',H'40',H'10',H'9',H'5',H'4',H'1'
ROMAN DC CL2'M',CL2'CM',CL2'D',CL2'CD',CL2'C',CL2'XC'
DC CL2'L',CL2'XL',CL2'X',CL2'IX',CL2'V',CL2'IV',CL2'I'
NUMS DC H'14',H'16',H'21',H'888',H'1492',H'1999',H'2020',H'3999'
PG DS CL80 buffer
XDEC DS CL12 temp for xdeco
REGEQU
END ROMAENC
- Output:
14 : XIV 16 : XVI 21 : XXI 888 : DCCCLXXXVIII 1492 : MCDXCII 1999 : MCMXCIX 2020 : MMXX 3999 : MMMCMXCIX
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
xthl ; load number
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
xthl ; load number
xra a ; find how many we need
subtract: inr a ; with trial subtraction
dad d
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
dad d
pop d ; restore counter (into D)
xthl ; load table pointer
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 70h,0feh,'CD',0 ; added using `dad'.
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
readdgt: ldax b
ana a
jz convert
dad h ; hl *= 10
mov d,h
mov e,l
dad h
dad h
dad d
sui '0'
mov e,a
mvi d,0
dad d
inx b
jmp readdgt
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
LoadSegment ds,ax,@data
mov al,01h
mov byte ptr [ds:error_code],al
mov ax, offset EncodeRoman
mov word ptr [ds:error_routine],ax
LoadSegment ds,ax,@code
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"
Roman_Error db "ERROR: BAD INPUT",0
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 ERROR: BAD INPUT
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:
Screenshot from Atari 8-bit computer
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
Ada
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
[]CHAR roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands #
[]CHAR adjust roman = "CCXXmmccxxii";
[]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
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
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
(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]}
script stringAddedValueDeducted
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
concat(snd(mapAccumL(stringAddedValueDeducted, n, kvs)))
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
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
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
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
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
Chipmunk Basic
100 cls
110 dim arabic(12), roman$(12)
120 for j = 0 to 12 : read arabic(j),roman$(j) : next j
130 data 1000,"M", 900,"CM", 500,"D", 400,"CD", 100,"C", 90,"XC"
140 data 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"
187 avalor = 1990 : print avalor "= "; : gosub 220 : print roman$ ' MCMXC
188 avalor = 2008 : print avalor "= "; : gosub 220 : print roman$ ' MMXXII
189 avalor = 1666 : print avalor "= "; : gosub 220 : print roman$ ' MDCLXVI
200 end
210 rem Encode to Roman
220 roman$ = "" : i = 0
230 while (i <= 12) and (avalor > 0)
240 while avalor >= arabic(i)
250 roman$ = roman$+roman$(i)
260 avalor = avalor-arabic(i)
270 wend
280 i = i+1
290 wend
300 return
- Output:
1990 = MCMXC 2008 = MMVIII 1666 = MDCLXVI
Commodore BASIC
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
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
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
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
Gambas
Public Sub Main()
'Testing
Print "2009 = "; toRoman(2009)
Print "1666 = "; toRoman(1666)
Print "3888 = "; toRoman(3888)
End
Function toRoman(value As Integer) As String
Dim result As String
Dim arabic As Integer[] = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
Dim roman As String[] = ["M", "CM", "D", "CD", "C", "XC", "L" , "XL", "X", "IX", "V", "IV", "I"]
For i As Integer = 0 To arabic.Max
Do While value >= arabic[i]
result &= roman[i]
value -= arabic[i]
Loop
Next
Return result
End Function
- Output:
Same as FreeBASIC entry.
GW-BASIC
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
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
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
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
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
Read.s refRomanNum(i)\symbol
Next
Restore denomValues
For i = 0 To #SymbolCount
Read refRomanNum(i)\value
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
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
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
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
@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
⟨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
Not thread-safe
#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.char````bigNum.char``";
value twoCharValue = bigNum.int - smallNum.int;
return "``twoCharSymbol````toRoman(hindu - twoCharValue, tierIndex)``";
}
else if (exists num = tier.reversed.find((Numeral elem) => hindu >= elem.int)) {
return "``num.char````toRoman(hindu - num.int, tierIndex)``";
}
else {
// nothing was found so move to the next smaller tier!
return toRoman(hindu, tierIndex - 1);
}
}
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
stream$putl(po, int$unparse(test) || " = " || roman$encode(test))
end
end start_up
- Output:
1666 = MDCLXVI 2008 = MMVIII 1001 = MI 1999 = MCMXCIX 3888 = MMMDCCCLXXXVIII 2021 = MMXXI
COBOL
IDENTIFICATION DIVISION.
PROGRAM-ID. TOROMAN.
DATA DIVISION.
working-storage section.
01 ws-number pic 9(4) value 0.
01 ws-save-number pic 9(4).
01 ws-tbl-def.
03 filler pic x(7) value '1000M '.
03 filler pic x(7) value '0900CM '.
03 filler pic x(7) value '0500D '.
03 filler pic x(7) value '0400CD '.
03 filler pic x(7) value '0100C '.
03 filler pic x(7) value '0090XC '.
03 filler pic x(7) value '0050L '.
03 filler pic x(7) value '0040XL '.
03 filler pic x(7) value '0010X '.
03 filler pic x(7) value '0009IX '.
03 filler pic x(7) value '0005V '.
03 filler pic x(7) value '0004IV '.
03 filler pic x(7) value '0001I '.
01 filler redefines ws-tbl-def.
03 filler occurs 13 times indexed by rx.
05 ws-tbl-divisor pic 9(4).
05 ws-tbl-roman-ch pic x(1) occurs 3 times indexed by cx.
01 ocx pic 99.
01 ws-roman.
03 ws-roman-ch pic x(1) occurs 16 times.
PROCEDURE DIVISION.
accept ws-number
perform
until ws-number = 0
move ws-number to ws-save-number
if ws-number > 0 and ws-number < 4000
initialize ws-roman
move 0 to ocx
perform varying rx from 1 by +1
until ws-number = 0
perform until ws-number < ws-tbl-divisor (rx)
perform varying cx from 1 by +1
until ws-tbl-roman-ch (rx, cx) = spaces
compute ocx = ocx + 1
move ws-tbl-roman-ch (rx, cx) to ws-roman-ch (ocx)
end-perform
compute ws-number = ws-number - ws-tbl-divisor (rx)
end-perform
end-perform
display 'inp=' ws-save-number ' roman=' ws-roman
else
display 'inp=' ws-save-number ' invalid'
end-if
accept ws-number
end-perform
.
- Output:
(input was supplied via STDIN)
inp=0111 roman=CXI inp=2234 roman=MMCCXXXIV inp=0501 roman=DI inp=0010 roman=X inp=0040 roman=XL inp=0050 roman=L inp=0066 roman=LXVI inp=0666 roman=DCLXVI inp=5666 invalid inp=3333 roman=MMMCCCXXXIII inp=3888 roman=MMMDCCCLXXXVIII inp=3999 roman=MMMCMXCIX inp=3345 roman=MMMCCCXLV
CoffeeScript
decimal_to_roman = (n) ->
# This should work for any positive integer, although it
# gets a bit preposterous for large numbers.
if n >= 4000
thousands = decimal_to_roman n / 1000
ones = decimal_to_roman n % 1000
return "M(#{thousands})#{ones}"
s = ''
translate_each = (min, roman) ->
while n >= min
n -= min
s += roman
translate_each 1000, "M"
translate_each 900, "CM"
translate_each 500, "D"
translate_each 400, "CD"
translate_each 100, "C"
translate_each 90, "XC"
translate_each 50, "L"
translate_each 40, "XL"
translate_each 10, "X"
translate_each 9, "IX"
translate_each 5, "V"
translate_each 4, "IV"
translate_each 1, "I"
s
###################
tests =
IV: 4
XLII: 42
MCMXC: 1990
MMVIII: 2008
MDCLXVI: 1666
'M(IV)': 4000
'M(VI)IX': 6009
'M(M(CXXIII)CDLVI)DCCLXXXIX': 123456789
'M(MMMV)I': 3005001
for expected, decimal of tests
roman = decimal_to_roman(decimal)
if roman == expected
console.log "#{decimal} = #{roman}"
else
console.log "error for #{decimal}: #{roman} is wrong"
Common Lisp
(defun roman-numeral (n)
(format nil "~@R" n))
Cowgol
include "cowgol.coh";
include "argv.coh";
# Encode the given number as a Roman numeral
sub decimalToRoman(num: uint16, buf: [uint8]): (rslt: [uint8]) is
# return the start of the buffer for easy printing
rslt := buf;
# Add string to buffer
sub Add(str: [uint8]) is
while [str] != 0 loop
[buf] := [str];
buf := @next buf;
str := @next str;
end loop;
end sub;
# Table of Roman numerals
record Roman is
value: uint16;
string: [uint8];
end record;
var numerals: Roman[] := {
{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"}
};
var curNum := &numerals as [Roman];
while num != 0 loop
while num >= curNum.value loop
Add(curNum.string);
num := num - curNum.value;
end loop;
curNum := @next curNum;
end loop;
[buf] := 0; # terminate the string
end sub;
# Read numbers from the command line and print the corresponding Roman numerals
ArgvInit();
var buffer: uint8[100];
loop
var argmt := ArgvNext();
if argmt == (0 as [uint8]) then
break;
end if;
var dummy: [uint8];
var number: int32;
(number, dummy) := AToI(argmt);
print(decimalToRoman(number as uint16, &buffer as [uint8]));
print_nl();
end loop;
- Output:
$ ./romanenc.386 1990 2008 1666 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
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
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
func$ dec2rom dec .
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" ]
for i = 1 to len values[]
while dec >= values[i]
rom$ &= symbol$[i]
dec -= values[i]
.
.
return rom$
.
print dec2rom 1990
print dec2rom 2008
print dec2rom 1666
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
Ed
H
g/0([0-9]{3})/s//\1/
g/1([0-9]{3})/s//M\1/
g/2([0-9]{3})/s//MM\1/
g/3([0-9]{3})/s//MMM\1/
g/4([0-9]{3})/s//MMMM\1/
g/0([0-9]{2})/s//\1/
g/1([0-9]{2})/s//C\1/
g/2([0-9]{2})/s//CC\1/
g/3([0-9]{2})/s//CCC\1/
g/4([0-9]{2})/s//CD\1/
g/5([0-9]{2})/s//D\1/
g/6([0-9]{2})/s//DC\1/
g/7([0-9]{2})/s//DCC\1/
g/8([0-9]{2})/s//DCCC\1/
g/9([0-9]{2})/s//CM\1/
g/0([0-9]{2})/s//\1/
g/1([0-9]{1})/s//X\1/
g/2([0-9]{1})/s//XX\1/
g/3([0-9]{1})/s//XXX\1/
g/4([0-9]{1})/s//XL\1/
g/5([0-9]{1})/s//L\1/
g/6([0-9]{1})/s//LX\1/
g/7([0-9]{1})/s//LXX\1/
g/8([0-9]{1})/s//LXXX\1/
g/9([0-9]{1})/s//XC\1/
g/0([0-9]{1})/s//\1/
g/1/s//I/
g/2/s//II/
g/3/s//III/
g/4/s//IV/
g/5/s//V/
g/6/s//VI/
g/7/s//VII/
g/8/s//VIII/
g/9/s//IX/
g/0/s///
,p
Q
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
ELENA 6.x :
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).Value, 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
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:
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
-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
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
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'
Haskell
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 ()
main = (putStrLn . unlines) (roman <$> [1666, 1990, 2008, 2016, 2018])
- Output:
MDCLXVI MCMXC MMVIII MMXVI MMXVIII
With the Roman patterns abstracted, and in a simple logic programming idiom:
module Main where
------------------------
-- ENCODER FUNCTION --
------------------------
romanDigits = "IVXLCDM"
-- Meaning and indices of the romanDigits sequence:
--
-- magnitude | 1 5 | index
-- -----------|-------|-------
-- 0 | I V | 0 1
-- 1 | X L | 2 3
-- 2 | C D | 4 5
-- 3 | M | 6
--
-- romanPatterns are index offsets into romanDigits,
-- from an index base of 2 * magnitude.
romanPattern 0 = [] -- empty string
romanPattern 1 = [0] -- I or X or C or M
romanPattern 2 = [0,0] -- II or XX...
romanPattern 3 = [0,0,0] -- III...
romanPattern 4 = [0,1] -- IV...
romanPattern 5 = [1] -- ...
romanPattern 6 = [1,0]
romanPattern 7 = [1,0,0]
romanPattern 8 = [1,0,0,0]
romanPattern 9 = [0,2]
encodeValue 0 _ = ""
encodeValue value magnitude = encodeValue rest (magnitude + 1) ++ digits
where
low = rem value 10 -- least significant digit (encoded now)
rest = div value 10 -- the other digits (to be encoded next)
indices = map addBase (romanPattern low)
addBase i = i + (2 * magnitude)
digits = map pickDigit indices
pickDigit i = romanDigits!!i
encode value = encodeValue value 0
------------------
-- TEST SUITE --
------------------
main = do
test "MCMXC" 1990
test "MMVIII" 2008
test "MDCLXVI" 1666
test expected value = putStrLn ((show value) ++ " = " ++ roman ++ remark)
where
roman = encode value
remark =
" (" ++
(if roman == expected then "PASS"
else ("FAIL, expected " ++ (show expected))) ++ ")"
- Output:
1990 = MCMXC (PASS) 2008 = MMVIII (PASS) 1666 = MDCLXVI (PASS)
HicEst
CHARACTER Roman*20
CALL RomanNumeral(1990, Roman) ! MCMXC
CALL RomanNumeral(2008, Roman) ! MMVIII
CALL RomanNumeral(1666, Roman) ! MDCLXVI
END
SUBROUTINE RomanNumeral( arabic, roman)
CHARACTER roman
DIMENSION ddec(13)
DATA ddec/1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1/
roman = ' '
todo = arabic
DO d = 1, 13
DO rep = 1, todo / ddec(d)
roman = TRIM(roman) // TRIM(CHAR(d, 13, "M CM D CD C XC L XL X OX V IV I "))
todo = todo - ddec(d)
ENDDO
ENDDO
END
Hoon
Library file (e.g. /lib/rhonda.hoon
):
|%
++ parse
|= t=tape ^- @ud
=. t (cass t)
=| result=@ud
|-
?~ t result
?~ t.t (add result (from-numeral i.t))
=+ [a=(from-numeral i.t) b=(from-numeral i.t.t)]
?: (gte a b) $(result (add result a), t t.t)
$(result (sub (add result b) a), t t.t.t)
++ yield
|= n=@ud ^- tape
=| result=tape
=/ values to-numeral
|-
?~ values result
?: (gte n -.i.values)
$(result (weld result +.i.values), n (sub n -.i.values))
$(values t.values)
++ from-numeral
|= c=@t ^- @ud
?: =(c 'i') 1
?: =(c 'v') 5
?: =(c 'x') 10
?: =(c 'l') 50
?: =(c 'c') 100
?: =(c 'd') 500
?: =(c 'm') 1.000
!!
++ to-numeral
^- (list [@ud tape])
:*
[1.000 "m"]
[900 "cm"]
[500 "d"]
[400 "cd"]
[100 "c"]
[90 "xc"]
[50 "l"]
[40 "xl"]
[10 "x"]
[9 "ix"]
[5 "v"]
[4 "iv"]
[1 "i"]
~
==
--
Script file ("generator") (e.g. /gen/roman.hoon
):
/+ *roman
:- %say
|= [* [x=$%([%from-roman tape] [%to-roman @ud]) ~] ~]
:- %noun
^- tape
?- -.x
%from-roman "{<(parse +.x)>}"
%to-roman (yield +.x)
==
Icon and Unicon
numbers.icn provides roman as seen below and is based upon a James Gimple SNOBOL4 function.
- Output:
#roman.exe 3 4 8 49 2010 1666 3000 3999 4000 3 -> III 4 -> IV 8 -> VIII 49 -> XLIX 2,010 -> MMX 1,666 -> MDCLXVI 3,999 -> MMMCMXCIX 4,000 -> *** can't convert to Roman numerals ***
Intercal
INTERCAL outputs numbers as Roman numerals by default, so this is surprisingly trivial for a language that generally tries to make things as difficult as possible. Although you do still have to input the numbers as spelled out digitwise in all caps.
PLEASE WRITE IN .1
DO READ OUT .1
DO GIVE UP
- Output:
$ ./roman ONE SIX SIX SIX MDCLXVI
Io
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
The conversion function throws an IllegalArgumentException for non-positive numbers, since Java does not have unsigned primitives.
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)
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
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
(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 ----------------
// Tuple (,) :: a -> b -> (a, b)
const Tuple = a =>
// A pair of values, possibly of
// different types.
b => ({
type: "Tuple",
"0": a,
"1": b,
length: 2,
*[Symbol.iterator]() {
for (const k in this) {
if (!isNaN(k)) {
yield this[k];
}
}
}
});
// 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, bs], x) => second(
v => [...bs, v]
)(
f(a)(x)
),
[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 => Tuple(
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 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
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 '1' is removed and the function is recursively called with [] (the empty list)..
- 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 '2' is removed and the function is recursively called with ['1'].
- 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.
Miranda
main :: [sys_message]
main = [ Stdout (show n ++ ": " ++ toroman n ++ "\n")
| n <- [1990, 2008, 1666, 2023]]
toroman :: num->[char]
toroman 0 = ""
toroman n = d ++ toroman (n - v)
where 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)]
(d, v) = hd [(d,v) | (d,v) <- digits; v <= n]
- Output:
1990: MCMXC 2008: MMVIII 1666: MDCLXVI 2023: MMXXIII
Modula-2
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
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
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
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
PascalABC.NET
var anums := |1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1|;
var rnums := 'M CM D CD C XC L XL X IX V IV I'.split;
function ToRoman(x: integer): string;
begin
Result := '';
foreach var (a,r) in anums.Zip(rnums) do
begin
var n := x div a;
x := x mod a;
Result += r * n;
end;
end;
begin
var 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|;
foreach var x in test do
Println($'{x} - {ToRoman(x)}')
end.
- Output:
1666 - MDCLXVI 1945 - MCMXLV 1997 - MCMXCVII 1999 - MCMXCIX 2000 - MM 2008 - MMVIII 2010 - MMX 2011 - MMXI 2500 - MMD 3000 - MMM 3999 - MMMCMXCIX
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</@></@>
<@ ENU$$DLSTLITLIT>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;
}
say roman($_) for 1..2012;
Using a module
use Math::Roman qw/roman/;
say roman($_) for 1..2012'
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
with javascript_semantics
function toRoman(integer v)
sequence 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 {v,res} -- (for output)
end function
?apply({1990,2008,1666},toRoman)
- Output:
{{1990,"MCMXC"},{2008,"MMVIII"},{1666,"MDCLXVI"}}
cheating slightly
with javascript_semantics
requires("1.0.5")
function toRoman(integer n)
return {n,sprintf("%R",n)}
end function
same output (builtins\VM\pprntfN.e/toRoman() is somewhat more obfuscated and faster than the above)
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
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
/**
* 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
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, u) --> ['IX'].
unity(9, t) --> ['XC'].
unity(9, h) --> ['CM'].
unity(9, th)--> ['MMMMMMMMM'].
unity(0, _) --> [].
unity(V, U)-->
{V #> 5,
V1 #= V - 5},
unity(5, U),
unity(V1, U).
unity(V, U) -->
{V #> 1, V #< 4,
V1 #= V-1},
unity(1, U),
unity(V1, U).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Extraction of roman "lexeme"
parse_Roman(['C','M'|T]) -->
['CM'],
parse_Roman(T).
parse_Roman(['C','D'|T]) -->
['CD'],
parse_Roman(T).
parse_Roman(['X','C'| T]) -->
['XC'],
parse_Roman(T).
parse_Roman(['X','L'| T]) -->
['XL'],
parse_Roman(T).
parse_Roman(['I','X'| T]) -->
['IX'],
parse_Roman(T).
parse_Roman(['I','V'| T]) -->
['IV'],
parse_Roman(T).
parse_Roman([H | T]) -->
[H],
parse_Roman(T).
parse_Roman([]) -->
[].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
my_print(A, R) :-
format('~w in roman is ~w~n', [A, R]).
- Output:
?- roman. 1789 in roman is MDCCLXXXIX 2010 in roman is MMX 110 in roman is CX 1449 in roman is MCDXLIX 1666 in roman is MDCLXVI true .
Python
Pythonic
import roman
print(roman.toRoman(2022))
Minimalistic structuralism
def toRoman(n):
res='' #converts int to str(Roman numeral)
reg=n #using the numerals (M,D,C,L,X,V,I)
if reg<4000:#no more than three repetitions
while reg>=1000: #thousands up to MMM
res+='M' #MAX is MMMCMXCIX
reg-=1000
if reg>=900: #nine hundreds in 900-999
res+='CM'
reg-=900
if reg>=500: #five hudreds in 500-899
res+='D'
reg-=500
if reg>=400: #four hundreds in 400-499
res+='CD'
reg-=400
while reg>=100: #hundreds in 100-399
res+='C'
reg-=100
if reg>=90: #nine tens in 90-99
res+='XC'
reg-=90
if reg>=50: #five Tens in 50-89
res+='L'
reg-=50
if reg>=40:
res+='XL' #four Tens
reg-=40
while reg>=10:
res+="X" #tens
reg-=10
if reg>=9:
res+='IX' #nine Units
reg-=9
if reg>=5:
res+='V' #five Units
reg-=5
if reg>=4:
res+='IV' #four Units
reg-=4
while reg>0: #three or less Units
res+='I'
reg-=1
return res
Imperative
- Version for Python 2
roman = "MDCLXVmdclxvi"; # UPPERCASE for thousands #
adjust_roman = "CCXXmmccxxii";
arabic = (1000000, 500000, 100000, 50000, 10000, 5000, 1000, 500, 100, 50, 10, 5, 1);
adjust_arabic = (100000, 100000, 10000, 10000, 1000, 1000, 100, 100, 10, 10, 1, 1, 0);
def arabic_to_roman(dclxvi):
org = dclxvi; # 666 #
out = "";
for scale,arabic_scale in enumerate(arabic):
if org == 0: break
multiples = org / arabic_scale;
org -= arabic_scale * multiples;
out += roman[scale] * multiples;
if org >= -adjust_arabic[scale] + arabic_scale:
org -= -adjust_arabic[scale] + arabic_scale;
out += adjust_roman[scale] + roman[scale]
return out
if __name__ == "__main__":
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);
for val in test:
print '%d - %s'%(val, arabic_to_roman(val))
An alternative which uses the divmod() function
romanDgts= 'ivxlcdmVXLCDM_'
def ToRoman(num):
namoR = ''
if num >=4000000:
print 'Too Big -'
return '-----'
for rdix in range(0, len(romanDgts), 2):
if num==0: break
num,r = divmod(num,10)
v,r = divmod(r, 5)
if r==4:
namoR += romanDgts[rdix+1+v] + romanDgts[rdix]
else:
namoR += r*romanDgts[rdix] + (romanDgts[rdix+1] if(v==1) else '')
return namoR[-1::-1]
It is more Pythonic to use zip to iterate over two lists together:
anums = [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".split()
def to_roman(x):
ret = []
for a,r in zip(anums, rnums):
n,x = divmod(x,a)
ret.append(r*n)
return ''.join(ret)
if __name__ == "__main__":
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)
for val in test:
print '%d - %s'%(val, to_roman(val))
- Version for Python 3
def arabic_to_roman(dclxvi):
#===========================
'''Convert an integer from the decimal notation to the Roman notation'''
org = dclxvi; # 666 #
out = "";
for scale, arabic_scale in enumerate(arabic):
if org == 0: break
multiples = org // arabic_scale;
org -= arabic_scale * multiples;
out += roman[scale] * multiples;
if (org >= -adjust_arabic[scale] + arabic_scale):
org -= -adjust_arabic[scale] + arabic_scale;
out += adjust_roman[scale] + roman[scale]
return out
if __name__ == "__main__":
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);
for val in test:
print("%8d %s" %(val, arabic_to_roman(val)))
Declarative
Less readable, but a 'one liner':
rnl = [ { '4' : 'MMMM', '3' : 'MMM', '2' : 'MM', '1' : 'M', '0' : '' }, { '9' : 'CM', '8' : 'DCCC', '7' : 'DCC',
'6' : 'DC', '5' : 'D', '4' : 'CD', '3' : 'CCC', '2' : 'CC', '1' : 'C', '0' : '' }, { '9' : 'XC',
'8' : 'LXXX', '7' : 'LXX', '6' : 'LX', '5' : 'L', '4' : 'XL', '3' : 'XXX', '2' : 'XX', '1' : 'X',
'0' : '' }, { '9' : 'IX', '8' : 'VIII', '7' : 'VII', '6' : 'VI', '5' : 'V', '4' : 'IV', '3' : 'III',
'2' : 'II', '1' : 'I', '0' : '' }]
# Option 1
def number2romannumeral(n):
return ''.join([rnl[x][y] for x, y in zip(range(4), str(n).zfill(4)) if n < 5000 and n > -1])
# Option 2
def number2romannumeral(n):
return reduce(lambda x, y: x + y, map(lambda x, y: rnl[x][y], range(4), str(n).zfill(4))) if -1 < n < 5000 else None
Or, defining roman in terms of mapAccumL:
'''Encoding Roman Numerals'''
from functools import reduce
from itertools import chain
# romanFromInt :: Int -> String
def romanFromInt(n):
'''A string of Roman numerals encoding an integer.'''
def go(a, ms):
m, s = ms
q, r = divmod(a, m)
return (r, s * q)
return concat(snd(mapAccumL(go)(n)(
zip([
1000, 900, 500, 400, 100, 90, 50,
40, 10, 9, 5, 4, 1
], [
'M', 'CM', 'D', 'CD', 'C', 'XC', 'L',
'XL', 'X', 'IX', 'V', 'IV', 'I'
])
)))
# ------------------------- TEST -------------------------
# main :: IO ()
def main():
'''Sample of years'''
for s in [
romanFromInt(x) for x in [
1666, 1990, 2008, 2016, 2018, 2020
]
]:
print(s)
# ------------------ GENERIC FUNCTIONS -------------------
# concat :: [[a]] -> [a]
# concat :: [String] -> String
def concat(xxs):
'''The concatenation of all the elements in a list.'''
xs = list(chain.from_iterable(xxs))
unit = '' if isinstance(xs, str) else []
return unit if not xs else (
''.join(xs) if isinstance(xs[0], str) else xs
)
# mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
def mapAccumL(f):
'''A tuple of an accumulation and a list derived by a
combined map and fold,
with accumulation from left to right.'''
def go(a, x):
tpl = f(a[0], x)
return (tpl[0], a[1] + [tpl[1]])
return lambda acc: lambda xs: (
reduce(go, xs, (acc, []))
)
# snd :: (a, b) -> b
def snd(tpl):
'''Second component of a tuple.'''
return tpl[1]
# MAIN ---
if __name__ == '__main__':
main()
- Output:
MDCLXVI MCMXC MMVIII MMXVI MMXVIII MMXX
Quackery
Pasting epitomised.
[ $ ""
swap 1000 /mod $ "M" rot of rot swap join swap
dup 900 < not if [ 900 - dip [ $ "CM" join ] ]
dup 500 < not if [ 500 - dip [ $ "D" join ] ]
dup 400 < not if [ 400 - dip [ $ "CD" join ] ]
100 /mod $ "C" rot of rot swap join swap
dup 90 < not if [ 90 - dip [ $ "XC" join ] ]
dup 50 < not if [ 50 - dip [ $ "L" join ] ]
dup 40 < not if [ 40 - dip [ $ "XL" join ] ]
10 /mod $ "X" rot of rot swap join swap
dup 9 < not if [ 9 - dip [ $ "IX" join ] ]
dup 5 < not if [ 5 - dip [ $ "V" join ] ]
dup 4 < not if [ 4 - dip [ $ "IV" join ] ]
$ "I" swap of join ]
is ->roman ( n --> $ )
1990 dup echo say " = " ->roman echo$ cr
2008 dup echo say " = " ->roman echo$ cr
1666 dup echo say " = " ->roman echo$ cr
- Output:
1990 = MCMXC 2008 = MMVIII 1666 = MDCLXVI
R
R has a built-in function, as.roman
, for conversion to Roman numerals. The implementation details are found in utils:::.numeric2roman
(see previous link), and utils:::.roman2numeric
, for conversion back to Arabic decimals.
as.roman(1666) # MDCLXVI
Since the object as.roman
creates is just an integer vector with a class, you can do arithmetic with Roman numerals:
as.roman(1666) + 334 # MM
Racket
Straight recursion:
#lang racket
(define (encode/roman number)
(cond ((>= number 1000) (string-append "M" (encode/roman (- number 1000))))
((>= number 900) (string-append "CM" (encode/roman (- number 900))))
((>= number 500) (string-append "D" (encode/roman (- number 500))))
((>= number 400) (string-append "CD" (encode/roman (- number 400))))
((>= number 100) (string-append "C" (encode/roman (- number 100))))
((>= number 90) (string-append "XC" (encode/roman (- number 90))))
((>= number 50) (string-append "L" (encode/roman (- number 50))))
((>= number 40) (string-append "XL" (encode/roman (- number 40))))
((>= number 10) (string-append "X" (encode/roman (- number 10))))
((>= number 9) (string-append "IX" (encode/roman (- number 9))))
((>= number 5) (string-append "V" (encode/roman (- number 5))))
((>= number 4) (string-append "IV" (encode/roman (- number 4))))
((>= number 1) (string-append "I" (encode/roman (- number 1))))
(else "")))
Using for/fold and quotient/remainder to remove repetition:
#lang racket
(define (number->list n)
(for/fold ([result null])
([decimal '(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)])
#:break (= n 0)
(let-values ([(q r) (quotient/remainder n decimal)])
(set! n r)
(append result (make-list q roman)))))
(define (encode/roman number)
(string-join (map symbol->string (number->list number)) ""))
(for ([n '(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)])
(printf "~a ~a\n" n (encode/roman n)))
Raku
(formerly Perl 6)
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;
multi sub roman (0) { '' }
multi sub roman (Int $n) {
for @subtractors -> $cut, $minus {
$n >= $cut
and return %symbols{$cut} ~ roman($n - $cut);
$n >= $cut - $minus
and return %symbols{$minus} ~ roman($n + $minus);
}
}
# Sample usage
for 1 .. 2_010 -> $x {
say roman($x);
}
Red
Straight iterative solution:
Red []
table: [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: function [n [integer!] return: [string!]][
out: copy ""
foreach [a r] table [while [n >= a][append out r n: n - a]]
out
]
foreach number [40 33 1888 2016][print [number ":" to-Roman number]]
Straight recursive solution:
Red []
table: [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: func [n [integer!] return: [string!]][
case [
tail? table [table: head table copy ""]
table/1 > n [table: skip table 2 to-Roman n]
'else [append copy form table/2 to-Roman n - table/1]
]
]
foreach number [40 33 1888 2016][print [number ":" to-Roman number]]
This solution builds, using metaprogramming, a `case` table, that relies on recursion to convert every digit.
Red []
to-Roman: function [n [integer!]] reduce [
'case collect [
foreach [a r] [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][
keep compose/deep [n >= (a) [append copy (form r) any [to-Roman n - (a) copy ""]]]
]
]
]
foreach number [40 33 1888 2016][print [number ":" to-Roman number]]
Retro
This is a port of the Forth code; but returns a string rather than displaying the roman numerals. It only handles numbers between 1 and 3999.
: vector ( ...n"- )
here [ &, times ] dip : .data ` swap ` + ` @ ` do ` ; ;
: .I dup @ ^buffer'add ;
: .V dup 1 + @ ^buffer'add ;
: .X dup 2 + @ ^buffer'add ;
[ .I .X drop ]
[ .V .I .I .I drop ]
[ .V .I .I drop ]
[ .V .I drop ]
[ .V drop ]
[ .I .V drop ]
[ .I .I .I drop ]
[ .I .I drop ]
[ .I drop ]
&drop
10 vector .digit
: record ( an- )
10 /mod dup [ [ over 2 + ] dip record ] &drop if .digit ;
: toRoman ( n-a )
here ^buffer'set
dup 1 3999 within 0 =
[ "EX LIMITO!\n" ] [ "IVXLCDM" swap record here ] if ;
REXX
version 1
roman: procedure
arg number
/* handle only 1 to 3999, else return ? */
if number >= 4000 | number <= 0 then return "?"
romans = " M CM D CD C XC L XL X IX V IV I"
arabic = "1000 900 500 400 100 90 50 40 10 9 5 4 1"
result = ""
do i = 1 to words(romans)
do while number >= word(arabic,i)
result = result || word(romans,i)
number = number - word(arabic,i)
end
end
return result
version 2
This version of a REXX program allows almost any non-negative decimal integer.
Most people think that the Romans had no word for "zero". The Roman numeral system has no need for a
zero placeholder, so there was no name for it (just as we have no name for a "¶" in the middle of our
numbers ─── as we don't have that possibility). However, the Romans did have a name for zero (or nothing).
In fact the Romans had several names for zero (see the REXX code), as does modern English. In American
English, many words can be used for 0: zero, nothing, naught, bupkis, zilch, goose-egg, nebbish, squat, nil,
crapola, what-Patty-shot-at, nineteen (only in cribbage), love (in tennis), etc.
Also, this REXX version supports large numbers (with parentheses and deep parentheses).
(This REXX code was ripped out of my general routine that also supported versions for Attic, ancient Roman,
and modern Roman numerals.)
The general REXX code is bulkier than most at it deals with any non-negative decimal number, and more
boilerplate code is in the general REXX code to handle the above versions.
/*REXX program converts (Arabic) non─negative decimal integers (≥0) ───► Roman numerals.*/
numeric digits 10000 /*decimal digs can be higher if wanted.*/
parse arg # /*obtain optional integers from the CL.*/
@er= "argument isn't a non-negative integer: " /*literal used when issuing error msg. */
if #='' then /*Nothing specified? Then generate #s.*/
do
do j= 0 by 11 to 111; #=# j; end
#=# 49; do k=88 by 100 to 1200; #=# k; end
#=# 1000 2000 3000 4000 5000 6000; do m=88 by 200 to 1200; #=# m; end
#=# 1304 1405 1506 1607 1708 1809 1910 2011; do p= 4 to 50; #=# 10**p; end
end /*finished with generation of numbers. */
do i=1 for words(#); x=word(#, i) /*convert each of the numbers───►Roman.*/
if \datatype(x, 'W') | x<0 then say "***error***" @er x /*¬ whole #? negative?*/
say right(x, 55) dec2rom(x)
end /*i*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
dec2rom: procedure; parse arg n,# /*obtain the number, assign # to a null*/
n=space(translate(n/1, , ','), 0) /*remove commas from normalized integer*/
nulla= 'ZEPHIRUM NULLAE NULLA NIHIL' /*Roman words for "nothing" or "none". */
if n==0 then return word(nulla, 1) /*return a Roman word for "zero". */
maxnp=(length(n)-1)%3 /*find max(+1) # of parenthesis to use.*/
highPos=(maxnp+1)*3 /*highest position of number. */
nn=reverse( right(n, highPos, 0) ) /*digits for Arabic──►Roman conversion.*/
do j=highPos to 1 by -3
_=substr(nn, j, 1); select /*════════════════════hundreds.*/
when _==9 then hx='CM'
when _>=5 then hx='D'copies("C", _-5)
when _==4 then hx='CD'
otherwise hx= copies('C', _)
end /*select hundreds*/
_=substr(nn, j-1, 1); select /*════════════════════════tens.*/
when _==9 then tx='XC'
when _>=5 then tx='L'copies("X", _-5)
when _==4 then tx='XL'
otherwise tx= copies('X', _)
end /*select tens*/
_=substr(nn, j-2, 1); select /*═══════════════════════units.*/
when _==9 then ux='IX'
when _>=5 then ux='V'copies("I", _-5)
when _==4 then ux='IV'
otherwise ux= copies('I', _)
end /*select units*/
$=hx || tx || ux
if $\=='' then #=# || copies("(", (j-1)%3)$ ||copies(')', (j-1)%3)
end /*j*/
if pos('(I',#)\==0 then do i=1 for 4 /*special case: M,MM,MMM,MMMM.*/
if i==4 then _ = '(IV)'
else _ = '('copies("I", i)')'
if pos(_, #)\==0 then #=changestr(_, #, copies('M', i))
end /*i*/
return #
Some older REXXes don't have a changestr BIF, so one is included here ──► CHANGESTR.REX.
output when using the default (internal) input):
0 ZEPHIRUM 11 XI 22 XXII 33 XXXIII 44 XLIV 55 LV 66 LXVI 77 LXXVII 88 LXXXVIII 99 XCIX 110 CX 49 XLIX 88 LXXXVIII 188 CLXXXVIII 288 CCLXXXVIII 388 CCCLXXXVIII 488 CDLXXXVIII 588 DLXXXVIII 688 DCLXXXVIII 788 DCCLXXXVIII 888 DCCCLXXXVIII 988 CMLXXXVIII 1088 MLXXXVIII 1188 MCLXXXVIII 1000 M 2000 MM 3000 MMM 4000 MMMM 5000 (V) 6000 (VI) 88 LXXXVIII 288 CCLXXXVIII 488 CDLXXXVIII 688 DCLXXXVIII 888 DCCCLXXXVIII 1088 MLXXXVIII 1304 MCCCIV 1405 MCDV 1506 MDVI 1607 MDCVII 1708 MDCCVIII 1809 MDCCCIX 1910 MCMX 2011 MMXI 10000 (X) 100000 (C) 1000000 (M) 10000000 ((X)) 100000000 ((C)) 1000000000 ((M)) 10000000000 (((X))) 100000000000 (((C))) 1000000000000 (((M))) 10000000000000 ((((X)))) 100000000000000 ((((C)))) 1000000000000000 ((((M)))) 10000000000000000 (((((X))))) 100000000000000000 (((((C))))) 1000000000000000000 (((((M))))) 10000000000000000000 ((((((X)))))) 100000000000000000000 ((((((C)))))) 1000000000000000000000 ((((((M)))))) 10000000000000000000000 (((((((X))))))) 100000000000000000000000 (((((((C))))))) 1000000000000000000000000 (((((((M))))))) 10000000000000000000000000 ((((((((X)))))))) 100000000000000000000000000 ((((((((C)))))))) 1000000000000000000000000000 ((((((((M)))))))) 10000000000000000000000000000 (((((((((X))))))))) 100000000000000000000000000000 (((((((((C))))))))) 1000000000000000000000000000000 (((((((((M))))))))) 10000000000000000000000000000000 ((((((((((X)))))))))) 100000000000000000000000000000000 ((((((((((C)))))))))) 1000000000000000000000000000000000 ((((((((((M)))))))))) 10000000000000000000000000000000000 (((((((((((X))))))))))) 100000000000000000000000000000000000 (((((((((((C))))))))))) 1000000000000000000000000000000000000 (((((((((((M))))))))))) 10000000000000000000000000000000000000 ((((((((((((X)))))))))))) 100000000000000000000000000000000000000 ((((((((((((C)))))))))))) 1000000000000000000000000000000000000000 ((((((((((((M)))))))))))) 10000000000000000000000000000000000000000 (((((((((((((X))))))))))))) 100000000000000000000000000000000000000000 (((((((((((((C))))))))))))) 1000000000000000000000000000000000000000000 (((((((((((((M))))))))))))) 10000000000000000000000000000000000000000000 ((((((((((((((X)))))))))))))) 100000000000000000000000000000000000000000000 ((((((((((((((C)))))))))))))) 1000000000000000000000000000000000000000000000 ((((((((((((((M)))))))))))))) 10000000000000000000000000000000000000000000000 (((((((((((((((X))))))))))))))) 100000000000000000000000000000000000000000000000 (((((((((((((((C))))))))))))))) 1000000000000000000000000000000000000000000000000 (((((((((((((((M))))))))))))))) 10000000000000000000000000000000000000000000000000 ((((((((((((((((X)))))))))))))))) 100000000000000000000000000000000000000000000000000 ((((((((((((((((C))))))))))))))))
Ring
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"]
see "2009 = " + toRoman(2009) + nl
see "1666 = " + toRoman(1666) + nl
see "3888 = " + toRoman(3888) + nl
func toRoman val
result = ""
for i = 1 to 13
while val >= arabic[i]
result = result + roman[i]
val = val - arabic[i]
end
next
return result
RPL
RPL code | Comment |
---|---|
≪ { 1000 900 500 400 100 90 50 40 10 9 5 4 1 } { "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I" } → divs rdig IF DUP 5000 < THEN "" SWAP 1 13 FOR j divs j GET MOD LAST / IP ROT SWAP WHILE DUP REPEAT rdig j GET ROT SWAP + SWAP 1 - END DROP SWAP NEXT END DROP ≫ '→ROM' STO |
→ROM ( n -- "ROMAN" ) store tables if n < 5000 then scan divisors x,y = divmod(n, divisor) if x > 0 then add related digit x times n = y clean stack |
Alternate version
RPL code | Comment |
---|---|
≪ IF DUP 5000 < THEN { "IIIVIIIX" "XXXLXXXC" "CCCDCCCM" } { 11 21 31 43 44 54 64 74 87 88 } → rom args ≪ "" SWAP 1 3 FOR j 10 MOD LAST / IP IF SWAP THEN args LAST GET 10 MOD LAST / IP rom j GET ROT ROT SUB ROT + SWAP END NEXT ≫ WHILE DUP REPEAT 1 - "M" ROT + SWAP END DROP END ≫ '→ROM' STO |
→ROM ( n -- "M..CXVI" ) collapsed Roman digits 10 arguments to extract Roman digits initialize stack process units to hundreds divmod(n,10) if last digit ≠ 0 then get extraction arguments extract Roman digit add thousands if any clean stack |
Ruby
Roman numeral generation was used as an example for demonstrating Test Driven Development in Ruby. The solution came to be:
Symbols = { 1=>'I', 5=>'V', 10=>'X', 50=>'L', 100=>'C', 500=>'D', 1000=>'M' }
Subtractors = [ [1000, 100], [500, 100], [100, 10], [50, 10], [10, 1], [5, 1], [1, 0] ]
def roman(num)
return Symbols[num] if Symbols.has_key?(num)
Subtractors.each do |cutPoint, subtractor|
return roman(cutPoint) + roman(num - cutPoint) if num > cutPoint
return roman(subtractor) + roman(num + subtractor) if num >= cutPoint - subtractor and num < cutPoint
end
end
[1990, 2008, 1666].each do |i|
puts "%4d => %s" % [i, roman(i)]
end
- Output:
1990 => MCMXC 2008 => MMVIII 1666 => MDCLXVI
Another shorter version if we don't consider calculating the substractors:
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 arabic_to_roman(arabic)
return '' if arabic.zero?
Symbols.each { |arabic_rep, roman_rep| return roman_rep + arabic_to_roman(arabic - arabic_rep) if arabic >= arabic_rep }
end
Yet another way to solve it in terms of reduce
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 to_roman(num)
Symbols.reduce "" do |memo, (divisor, letter)|
div, num = num.divmod(divisor)
memo + letter * div
end
end
Rust
struct RomanNumeral {
symbol: &'static str,
value: u32
}
const NUMERALS: [RomanNumeral; 13] = [
RomanNumeral {symbol: "M", value: 1000},
RomanNumeral {symbol: "CM", value: 900},
RomanNumeral {symbol: "D", value: 500},
RomanNumeral {symbol: "CD", value: 400},
RomanNumeral {symbol: "C", value: 100},
RomanNumeral {symbol: "XC", value: 90},
RomanNumeral {symbol: "L", value: 50},
RomanNumeral {symbol: "XL", value: 40},
RomanNumeral {symbol: "X", value: 10},
RomanNumeral {symbol: "IX", value: 9},
RomanNumeral {symbol: "V", value: 5},
RomanNumeral {symbol: "IV", value: 4},
RomanNumeral {symbol: "I", value: 1}
];
fn to_roman(mut number: u32) -> String {
let mut min_numeral = String::new();
for numeral in NUMERALS.iter() {
while numeral.value <= number {
min_numeral = min_numeral + numeral.symbol;
number -= numeral.value;
}
}
min_numeral
}
fn main() {
let nums = [2014, 1999, 25, 1666, 3888];
for &n in nums.iter() {
// 4 is minimum printing width, for alignment
println!("{:2$} = {}", n, to_roman(n), 4);
}
}
- Output:
2014 = MMXIV 1999 = MCMXCIX 25 = XXV 1666 = MDCLXVI 3888 = MMMDCCCLXXXVIII
Scala
val romanDigits = Map(
1 -> "I", 5 -> "V",
10 -> "X", 50 -> "L",
100 -> "C", 500 -> "D",
1000 -> "M",
4 -> "IV", 9 -> "IX",
40 -> "XL", 90 -> "XC",
400 -> "CD", 900 -> "CM")
val romanDigitsKeys = romanDigits.keysIterator.toList sortBy (x => -x)
def toRoman(n: Int): String = romanDigitsKeys find (_ >= n) match {
case Some(key) => romanDigits(key) + toRoman(n - key)
case None => ""
}
- Output:
scala> List(1990, 2008, 1666) map toRoman res55: List[String] = List(MCMXC, MMVIII, MDCLXVI)
Using foldLeft
def toRoman( v:Int ) : String = {
val romanNumerals = List(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")
var n = v
romanNumerals.foldLeft(""){(s,t) => {val c = n/t._1; n = n-t._1*c; s + (t._2 * c) } }
}
// A small test
def test( arabic:Int ) = println( arabic + " => " + toRoman( arabic ) )
test(1990)
test(2008)
test(1666)
Different code-style
def toRoman(num: Int): String = {
case class RomanUnit(value: Int, token: String)
val romanNumerals = List(
RomanUnit(1000, "M"),
RomanUnit(900, "CM"),
RomanUnit(500, "D"),
RomanUnit(400, "CD"),
RomanUnit(100, "C"),
RomanUnit(90, "XC"),
RomanUnit(50, "L"),
RomanUnit(40, "XL"),
RomanUnit(10, "X"),
RomanUnit(9, "IX"),
RomanUnit(5, "V"),
RomanUnit(4, "IV"),
RomanUnit(1, "I"))
var remainingNumber = num
romanNumerals.foldLeft("") { (outputStr, romanUnit) =>
{
val times = remainingNumber / romanUnit.value
remainingNumber -= romanUnit.value * times
outputStr + (romanUnit.token * times)
}
}
}
- Output:
1990 => MCMXC 2008 => MMVIII 1666 => MDCLXVI
Scheme
This uses format directives supported in Chez Scheme since v6.9b; YMMV.
(define (to-roman n)
(format "~@r" n))
This is a general example using Chicken Scheme.
(define roman-decimal
'(("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)))
(define (to-roman value)
(apply string-append
(let loop ((v value)
(decode roman-decimal))
(let ((r (caar decode))
(d (cdar decode)))
(cond
((= v 0) '())
((>= v d) (cons r (loop (- v d) decode)))
(else (loop v (cdr decode))))))))
(let loop ((n '(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)))
(unless (null? n)
(printf "~a ~a\n" (car n) (to-roman (car n)))
(loop (cdr n))))
Seed7
The following program writes the numbers between 1 and 3999 as roman numerals. The wrinum.s7i library contains the function str(ROMAN,), which writes a roman numeral to a string.
$ include "seed7_05.s7i";
include "stdio.s7i";
include "wrinum.s7i";
const proc: main is func
local
var integer: number is 0;
begin
for number range 1 to 3999 do
writeln(str(ROMAN, number));
end for;
end func;
Original source [1].
SenseTalk
function RomanNumeralsEncode number
put [
(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")
] into values
repeat for index = each item of (the number of items in values)..1
put item index of values into pair
repeat while number is greater than or equal to the first item of pair
put the second item of pair after numerals
subtract the first item of pair from number
end repeat
end repeat
return numerals
end RomanNumeralsEncode
repeat for each item in [
1990,
2008,
1666
]
put RomanNumeralsEncode(it)
end repeat
- Output:
MCMXC MMVIII MDCLXVI
SETL
examples := [2008, 1666, 1990];
for example in examples loop
print( roman_numeral(example) );
end loop;
proc roman_numeral( n );
R := [[1000, 'M'], [900, 'CM'], [500, 'D'], [400, 'CD'], [100, 'C'], [90, 'XC'], [50, 'L'], [40, 'XL'], [10, 'X'], [9, 'IX'], [5, 'V'], [4, 'IV'], [1, 'I']];
roman := '';
for numeral in R loop
while n >= numeral(1) loop
n := n - numeral(1);
roman := roman + numeral(2);
end loop;
end loop;
return roman;
end;
- Output:
MMVIII MDCLXVI MCMXC
Shen
(define encodeGlyphs
ACC 0 _ -> ACC
ACC N [Glyph Value | Rest] -> (encodeGlyphs (@s ACC Glyph) (- N Value) [Glyph Value | Rest]) where (>= N Value)
ACC N [Glyph Value | Rest] -> (encodeGlyphs ACC N Rest)
)
(define encodeRoman
N -> (encodeGlyphs "" N ["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:
(4-) (encodeRoman 1990) "MCMXC" (5-) (encodeRoman 2008) "MMVIII" (6-) (encodeRoman 1666) "MDCLXVI"
Sidef
func arabic2roman(num, roman='') {
static lookup = [
: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
];
lookup.each { |pair|
while (num >= pair.second) {
roman += pair.first;
num -= pair.second;
}
}
return roman;
}
say("1990 in roman is " + arabic2roman(1990));
say("2008 in roman is " + arabic2roman(2008));
say("1666 in roman is " + arabic2roman(1666));
- Output:
1990 in roman is MCMXC 2008 in roman is MMVIII 1666 in roman is MDCLXVI
Simula
BEGIN
TEXT PROCEDURE TOROMAN(N); INTEGER N;
BEGIN
PROCEDURE P(WEIGHT,LIT); INTEGER WEIGHT; TEXT LIT;
BEGIN
WHILE N >= WEIGHT DO
BEGIN
T :- T & LIT;
N := N - WEIGHT;
END WHILE;
END P;
TEXT T; T :- NOTEXT;
P( 1000, "M" );
P( 900, "CM" );
P( 500, "D" );
P( 400, "CD" );
P( 100, "C" );
P( 90, "XC" );
P( 50, "L" );
P( 40, "XL" );
P( 10, "X" );
P( 9, "IX" );
P( 5, "V" );
P( 4, "IV" );
P( 1, "I" );
TOROMAN :- T;
END TOROMAN;
INTEGER Y;
FOR Y := 1990, 2008, 1666 DO
BEGIN
OUTTEXT("YEAR ");
OUTINT(Y, 4);
OUTTEXT(" => ");
OUTTEXT(TOROMAN(Y));
OUTIMAGE;
END FOR;
END PROGRAM;
- Output:
YEAR 1990 => MCMXC YEAR 2008 => MMVIII YEAR 1666 => MDCLXVI
Smalltalk
in ST/X, integers already know how to print themselves as roman number:
2013 printRomanOn:Stdout naive:false
- Output:
MMXIII
the implementation is:
printRomanOn:aStream naive:naive
"print the receiver as roman number to the argument, aStream.
The naive argument controls if the conversion is
correct (i.e. subtracting prefix notation for 4,9,40,90, etc.),
or naive (i.e. print 4 as IIII and 9 as VIIII); also called simple.
The naive version is often used for page numbers in documents."
|restValue spec|
restValue := self.
restValue > 0 ifFalse:[self error:'negative roman'].
naive ifTrue:[
spec := #(
" value string repeat "
1000 'M' true
500 'D' false
100 'C' true
50 'L' false
10 'X' true
5 'V' false
1 'I' true
).
] ifFalse:[
spec := #(
" value string repeat "
1000 'M' true
900 'CM' false
500 'D' false
400 'CD' false
100 'C' true
90 'XC' false
50 'L' false
40 'XL' false
10 'X' true
9 'IX' false
5 'V' false
4 'IV' false
1 'I' true
).
].
spec
inGroupsOf:3
do:[:rValue :rString :repeatFlag |
[
(restValue >= rValue) ifTrue:[
aStream nextPutAll:rString.
restValue := restValue - rValue.
].
] doWhile:[ repeatFlag and:[ restValue >= rValue] ].
].
SNOBOL4
Adapted from Catspaw SNOBOL Tutorial, Chapter 6
* ROMAN(N) - Convert integer N to Roman numeral form.
*
* N must be positive and less than 4000.
*
* An asterisk appears in the result if N >= 4000.
*
* The function fails if N is not an integer.
DEFINE('ROMAN(N)UNITS') :(ROMAN_END)
* Get rightmost digit to UNITS and remove it from N.
* Return null result if argument is null.
ROMAN N RPOS(1) LEN(1) . UNITS = :F(RETURN)
* Search for digit, replace with its Roman form.
* Return failing if not a digit.
'0,1I,2II,3III,4IV,5V,6VI,7VII,8VIII,9IX,' UNITS
+ BREAK(',') . UNITS :F(FRETURN)
* Convert rest of N and multiply by 10. Propagate a
* failure return from recursive call back to caller.
ROMAN = REPLACE(ROMAN(N), 'IVXLCDM', 'XLCDM**')
+ UNITS :S(RETURN) F(FRETURN)
ROMAN_END
* Testing
OUTPUT = "1999 = " ROMAN(1999)
OUTPUT = " 24 = " ROMAN(24)
OUTPUT = " 944 = " ROMAN(944)
END
- Output:
1999 = MCMXCIX 24 = XXIV 944 = CMXLIV
Here's a non-recursive version, and a Roman-to-Arabic converter to boot.
* # Arabic to Roman
define('roman(n)s,ch,val,str') :(roman_end)
roman roman = ge(n,4000) n :s(return)
s = 'M1000 CM900 D500 CD400 C100 XC90 L50 XL40 X10 IX9 V5 IV4 I1 '
rom1 s span(&ucase) . ch break(' ') . val span(' ') = :f(rom2)
str = str dupl(ch,(n / val))
n = remdr(n,val) :(rom1)
rom2 roman = str :(return)
roman_end
* # Roman to Arabic
define('arabic(n)s,ch,val,sum,x') :(arabic_end)
arabic s = 'M1000 D500 C100 L50 X10 V5 I1 '
n = reverse(n)
arab1 n len(1) . ch = :f(arab2)
s ch break(' ') . val
val = lt(val,x) (-1 * val)
sum = sum + val; x = val :(arab1)
arab2 arabic = sum :(return)
arabic_end
* # Test and display
tstr = '2010 1999 1492 1066 476 '
tloop tstr break(' ') . year span(' ') = :f(out)
r = roman(year)
rstr = rstr year '=' r ' '
astr = astr r '=' arabic(r) ' ' :(tloop)
out output = rstr; output = astr
end
- Output:
2010=MMX 1999=MCMXCIX 1492=MCDXCII 1066=MLXVI 476=CDLXXVI MMX=2010 MCMXCIX=1999 MCDXCII=1492 MLXVI=1066 CDLXXVI=476
SPL
a2r(a)=
r = ""
n = [["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]]
> i, 1..13
> a!<n[i,2]
r += n[i,1]
a -= n[i,2]
<
<
<= r
.
t = [1990,2008,1666]
> i, 1..#.size(t,1)
#.output(t[i]," = ",a2r(t[i]))
<
- Output:
1990 = MCMXC 2008 = MMVIII 1666 = MDCLXVI
SQL
--
-- This only works under Oracle and has the limitation of 1 to 3999
SQL> select to_char(1666, 'RN') urcoman, to_char(1666, 'rn') lcroman from dual;
URCOMAN LCROMAN
--------------- ---------------
MDCLXVI mdclxvi
Swift
func ator(var n: Int) -> String {
var result = ""
for (value, letter) in
[( 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")]
{
while n >= value {
result += letter
n -= value
}
}
return result
}
Sample call:
println(ator(1666)) // MDCLXVI
print(ator(1666)) // MDCLXVI
- Output:
MDCLXVI
Tailspin
def digits: [(M:1000"1"), (CM:900"1"), (D:500"1"), (CD:400"1"), (C:100"1"), (XC:90"1"), (L:50"1"), (XL:40"1"), (X:10"1"), (IX:9"1"), (V:5"1"), (IV:4"1"), (I:1"1")];
templates encodeRoman
@: 1;
'$ -> ($)"1" -> #;' !
when <$digits($@)::value..> do
$digits($@)::key !
$ - $digits($@)::value -> #
when <1"1"..> do
@:$@ + 1;
$ -> #
end encodeRoman
1990 -> encodeRoman -> !OUT::write
'
' -> !OUT::write
2008 -> encodeRoman -> !OUT::write
'
' -> !OUT::write
1666 -> encodeRoman -> !OUT::write
- Output:
MCMXC MMVIII MDCLXVI
Tcl
proc to_roman {i} {
set 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}
foreach {value roman} $map {
while {$i >= $value} {
append res $roman
incr i -$value
}
}
return $res
}
TUSCRIPT
$$ MODE TUSCRIPT
LOOP arab_number="1990'2008'1666"
roman_number = ENCODE (arab_number,ROMAN)
PRINT "Arabic number ",arab_number, " equals ", roman_number
ENDLOOP
- Output:
Arabic number 1990 equals MCMXC Arabic number 2008 equals MMVIII Arabic number 1666 equals MDCLXVI
TypeScript
Weights and symbols in tuples.
// Roman numerals/Encode
const weightsSymbols: [number, 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']];
// 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded
// with these symbols.
function toRoman(n: number): string {
var roman = ""; // Result
for (i = 0; i <= 12 && n > 0; i++) {
var w = weightsSymbols[i][0];
while (n >= w) {
roman += weightsSymbols[i][1];
n -= w;
}
}
return roman;
}
console.log(toRoman(1990)); // MCMXC
console.log(toRoman(2022)); // MMXXII
console.log(toRoman(3888)); // MMMDCCCLXXXVIII
- Output:
MCMXC MMXXII MMMDCCCLXXXVIII
UNIX Shell
roman() {
local values=( 1000 900 500 400 100 90 50 40 10 9 5 4 1 )
local roman=(
[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
)
local nvmber=""
local num=$1
for value in ${values[@]}; do
while (( num >= value )); do
nvmber+=${roman[value]}
((num -= value))
done
done
echo $nvmber
}
for test in 1999 24 944 1666 2008; do
printf "%d = %s\n" $test $(roman $test)
done
- Output:
1999 = MCMXCIX 24 = XXIV 944 = CMXLIV 1666 = MDCLXVI 2008 = MMVIII
Ursala
The algorithm is to implement the subtractive principle by string substitution only after constucting the numeral from successive remainders. The order among the substitutions matters. For example, occurrences of DCCCC must be replaced by CM before any occurrences of CCCC are replaced by CD. The substitution operator (%=) is helpful here.
#import nat
roman =
-+
'IIII'%='IV'+ 'VIIII'%='IX'+ 'XXXX'%='XL'+ 'LXXXX'%='XC'+ 'CCCC'%='CD'+ 'DCCCC'%='CM',
~&plrDlSPSL/'MDCLXVI'+ iota*+ +^|(^|C/~&,\/division)@rlX=>~&iNC <1000,500,100,50,10,5>+-
This test program applies the function to each member of a list of numbers.
#show+
test = roman* <1990,2008,1,2,64,124,1666,10001>
- Output:
MCMXC MMVIII I II LXIV CXXIV MDCLXVI MMMMMMMMMMI
Vala
string to_roman(int n)
requires (n > 0 && n < 5000)
{
const int[] weights = {1000, 900, 500, 400, 100, 90,
50, 40, 10, 9, 5, 4, 1};
const string[] symbols = {"M","CM","D","CD","C","XC","L",
"XL","X","IX","V","IV","I"};
var roman = "", count = 0;
foreach (var w in weights) {
while (n >= w) {
roman += symbols[count];
n -= w;
}
if (n == 0)
break;
count++;
}
return roman;
}
void main() {
print("%s\n", to_roman(455));
print("%s\n", to_roman(3456));
print("%s\n", to_roman(2488));
}
- Output:
CDLV MMMCDLVI MMCDLXXXVIII
VBA
Private Function roman(n As Integer) As String
roman = WorksheetFunction.roman(n)
End Function
Public Sub main()
s = [{10, 2016, 800, 2769, 1666, 476, 1453}]
For Each x In s
Debug.Print roman(CInt(x)); " ";
Next x
End Sub
- Output:
X MMXVI DCCC MMDCCLXIX MDCLXVI CDLXXVI MCDLIII
Vedit macro language
// Main program for testing the function
//
do {
#1 = Get_Num("Number to convert: ", STATLINE)
Call("NUM_TO_ROMAN")
Num_Type(#1, NOCR) Message(" = ") Reg_Type(1) Type_Newline
} while (Reg_Size(1))
Return
// Convert numeric value into Roman number
// #1 = number to convert; on return: T-reg(1) = Roman number
//
:NUM_TO_ROMAN:
Reg_Empty(1) // @1 = Results (Roman number)
if (#1 < 1) { Return } // non-positive numbers return empty string
Buf_Switch(Buf_Free)
Ins_Text("M1000,CM900,D500,CD400,C100,XC90,L50,XL40,X10,IX9,V5,IV4,I1")
BOF
#2 = #1
Repeat(ALL) {
Search("|A|[|A]", ADVANCE+ERRBREAK) // get next item from conversion list
Reg_Copy_Block(20, CP-Chars_Matched, CP) // @20 = Letter(s) to be inserted
#11 = Num_Eval() // #11 = magnitude (1000...1)
while (#2 >= #11) {
Reg_Set(1, @20, APPEND)
#2 -= #11
}
}
Buf_Quit(OK)
Return
- Output:
4 = IV 12 = XII 1666 = MDCLXVI 1990 = MCMXC 2011 = MMXI
V (Vlang)
const numerals = {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"}
fn main() {
println(encode(1990))
println(encode(2008))
println(encode(1666))
}
fn encode(number int) string {
mut num := number
mut result := ""
if number < 1 || number > 5000 {return result}
for digit, roman in numerals {
for num >= digit {
num -= digit
result += roman
}
}
return result
}
- Output:
MCMXC MMVIII MDCLXVI
Wren
var 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"]
]
var encode = Fn.new { |n|
if (n > 5000 || n < 1) return null
var res = ""
for (r in romans) {
while (n >= r[0]) {
n = n - r[0]
res = res + r[1]
}
}
return res
}
System.print(encode.call(1990))
System.print(encode.call(1666))
System.print(encode.call(2008))
System.print(encode.call(2020))
- Output:
MCMXC MDCLXVI MMVIII MMXX
XLISP
(defun roman (n)
(define roman-numerals '((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")))
(defun romanize (arabic-numeral numerals roman-numeral)
(if (= arabic-numeral 0)
roman-numeral
(if (>= arabic-numeral (caar numerals))
(romanize (- arabic-numeral (caar numerals)) numerals (string-append roman-numeral (cadar numerals)))
(romanize arabic-numeral (cdr numerals) roman-numeral))))
(romanize n roman-numerals ""))
; test the function:
(display (mapcar roman '(10 2016 800 2769 1666 476 1453)))
- Output:
(x mmxvi dccc mmdcclxix mdclxvi cdlxxvi mcdliii)
XPL0
proc Rom(N, A, B, C); \Display 1..9 in Roman numerals
int N, A, B, C, I;
[case N of
9: [ChOut(0, C); ChOut(0, A)]; \XI
8,7,6,5:[ChOut(0, B); for I:= 1 to rem(N/5) do ChOut(0, C)]; \V
4: [ChOut(0, C); ChOut(0, B)] \IV
other for I:= 1 to N do ChOut(0, C); \I
];
proc Roman(N); \Display N in Roman numerals
int N, Q;
[Q:= N/1000; N:= rem(0); \0..3999
Rom(Q, ^?, ^?, ^M);
Q:= N/100; N:= rem(0); \0..999
Rom(Q, ^M, ^D, ^C);
Q:= N/10; N:= rem(0); \0..99
Rom(Q, ^C, ^L, ^X);
Rom(N, ^X, ^V, ^I); \0..9
];
int Tbl, I;
[Tbl:= [1990, 2008, 1666, 0, 1, 3999, 2020, 1234];
for I:= 0 to 7 do
[IntOut(0, Tbl(I)); Text(0, ". "); Roman(Tbl(I)); CrLf(0)];
]
- Output:
1990. MCMXC 2008. MMVIII 1666. MDCLXVI 0. 1. I 3999. MMMCMXCIX 2020. MMXX 1234. MCCXXXIV
XSLT
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:template match="/data/number">
<xsl:call-template name="for">
<xsl:with-param name="stop">13</xsl:with-param>
<xsl:with-param name="value"><xsl:value-of select="@value"></xsl:value-of></xsl:with-param>
</xsl:call-template>
</xsl:template>
<xsl:template name="for">
<xsl:param name="start">1</xsl:param>
<xsl:param name="stop">1</xsl:param>
<xsl:param name="step">1</xsl:param>
<xsl:param name="value">1</xsl:param>
<xsl:text/>
<xsl:choose>
<xsl:when test="($value > /data/roman
/numeral[@pos=$start]/@value or $value = /data/roman
/numeral[@pos=$start]/@value) ">
<xsl:value-of select="/data/roman
/numeral[@pos=$start]/@letter"/>
<xsl:call-template name="for">
<xsl:with-param name="stop">
<xsl:value-of select="$stop"/>
</xsl:with-param>
<xsl:with-param name="start">
<xsl:value-of select="$start"/>
</xsl:with-param>
<xsl:with-param name="value">
<xsl:value-of select="$value - /data/roman/numeral[@pos=$start]/@value"/>
</xsl:with-param>
</xsl:call-template>
</xsl:when>
<xsl:otherwise>
<xsl:if test="$start < $stop">
<xsl:call-template name="for">
<xsl:with-param name="stop">
<xsl:value-of select="$stop"/>
</xsl:with-param>
<xsl:with-param name="start">
<xsl:value-of select="$start + $step"/>
</xsl:with-param>
<xsl:with-param name="value">
<xsl:value-of select="$value"/>
</xsl:with-param>
</xsl:call-template>
</xsl:if>
</xsl:otherwise>
</xsl:choose>
</xsl:template>
</xsl:stylesheet>
zkl
var [const] romans = L(
L("M", 1000), L("CM", 900), L("D", 500), L("CD", 400), L("C", 100),
L("XC", 90), L("L", 50), L("XL", 40), L("X", 10), L("IX", 9),
L("V", 5), L("IV", 4), L("I", 1));
fcn toRoman(i){ // convert int to a roman number
reg text = "";
foreach R,N in (romans){ text += R*(i/N); i = i%N; }
return(text);
}
toRoman(1990) //-->"MCMXC" toRoman(2008) //-->"MMVIII" toRoman(1666) //-->"MDCLXVI"
Zoea
program: decimal_roman
input: 12
output: 'XII'
Zoea Visual
Zsh
Based on the python solution.
function printroman () {
local -a conv
local number=$1 div rom num out
conv=(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)
for num rom in ${(Oa)conv}; do
(( div = number / num, number = number % num ))
while (( div-- > 0 )); do
out+=$rom
done
done
echo $out
}
- Programming Tasks
- Solutions by Programming Task
- String manipulation
- GUISS/Omit
- 11l
- 360 Assembly
- 8080 Assembly
- 8086 Assembly
- Action!
- ActionScript
- Ada
- ALGOL 68
- ALGOL W
- APL
- AppleScript
- Arturo
- AutoHotkey
- Autolisp
- AWK
- BASIC
- Applesoft BASIC
- ASIC
- BaCon
- BASIC256
- BBC BASIC
- Chipmunk Basic
- Commodore BASIC
- FreeBASIC
- FutureBasic
- Gambas
- GW-BASIC
- IS-BASIC
- Liberty BASIC
- Microsoft Small Basic
- Nascom BASIC
- PowerBASIC
- PureBasic
- QBasic
- Run BASIC
- TI-83 BASIC
- True BASIC
- UBasic/4tH
- Visual Basic
- XBasic
- Yabasic
- ZX Spectrum Basic
- Batch File
- BCPL
- Befunge
- BQN
- Bracmat
- C
- C sharp
- C++
- Ceylon
- Clojure
- CLU
- COBOL
- CoffeeScript
- Common Lisp
- Cowgol
- D
- Delphi
- DWScript
- EasyLang
- ECL
- Ed
- Eiffel
- Ela
- Elena
- Elixir
- Emacs Lisp
- Erlang
- ERRE
- Euphoria
- Excel
- F Sharp
- Factor
- FALSE
- Fan
- Forth
- Fortran
- Go
- Golo
- Groovy
- Haskell
- HicEst
- Hoon
- Icon
- Unicon
- Icon Programming Library
- Intercal
- Io
- J
- Java
- JavaScript
- Jq
- Jsish
- Julia
- Kotlin
- Lasso
- LaTeX
- LiveCode
- Logo
- LOLCODE
- LotusScript
- Lua
- M4
- Maple
- Mathematica
- Wolfram Language
- Mercury
- Miranda
- Modula-2
- MUMPS
- Nim
- Objeck
- OCaml
- Oforth
- OpenEdge/Progress
- Oz
- PARI/GP
- Pascal
- PascalABC.NET
- Peloton
- Perl
- Phix
- Phixmonti
- PHP
- Picat
- PicoLisp
- Pike
- PL/I
- PL/SQL
- PlainTeX
- PowerShell
- Prolog
- Clpfd
- Python
- Quackery
- R
- Racket
- Raku
- Red
- Retro
- REXX
- Ring
- RPL
- Ruby
- Rust
- Scala
- Scheme
- Seed7
- SenseTalk
- SETL
- Shen
- Sidef
- Simula
- Smalltalk
- SNOBOL4
- SPL
- SQL
- Swift
- Tailspin
- Tcl
- TUSCRIPT
- TypeScript
- UNIX Shell
- Ursala
- Vala
- VBA
- Vedit macro language
- V (Vlang)
- Wren
- XLISP
- XPL0
- XSLT
- Zkl
- Zoea
- Zoea Visual
- Zsh
- Pages with too many expensive parser function calls