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:
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 retV 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))
* Roman numerals Encode - 11/05/2020ROMAENC 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 saveARABIC 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 bufferXDEC DS CL12 temp for xdeco REGEQU END ROMAENC
14 : XIV 16 : XVI 21 : XXI 888 : DCCCLXXXVIII1492 : MCDXCII1999 : MCMXCIX2020 : MMXX3999 : MMMCMXCIX
org100hjmptest;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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:pushh; put input on stacklxih,mkromantabmkromandgt:mova,m; scan ahead to next entryanaainxhjnzmkromandgtxthl; load numbermova,h; if zero, we're doneoraljzmkromandonexthl; load next entry from tablemove,m; de = numberinxhmovd,minxhxthl; load numberxraa; find how many we needsubtract:inra; with trial subtractiondaddjcsubtractpushpsw; keep countermova,d; we subtracted one too manycma; so we need to add one backmovd,amova,ecmamove,ainxddaddpopd; restore counter (into D)xthl; load table pointerstringouter:dcrd; do we need to include one?jzmkromandgtpushh; keep string locationstringinner:mova,m; copy string into targetstaxbanaa; done yet?jzstringdoneinxhinxb; copy next characterjmpstringinnerstringdone:poph; restore string locationjmpstringoutermkromandone:popd; remove temporary variable from stackretmkromantab:db0db18h,0fch,'M',0; The value for each entrydb7ch,0fch,'CM',0; is stored already negateddb0ch,0feh,'D',0; so that it can be immediatelydb70h,0feh,'CD',0; added using `dad'.db9ch,0ffh,'C',0; This also has the convenientdb0a6h,0ffh,'XC',0; property of not having anydb0ceh,0ffh,'L',0; zero bytes except the stringdb0d8h,0ffh,'XL',0; and row terminators.db0f6h,0ffh,'X',0db0f7h,0ffh,'IX',0db0fbh,0ffh,'V',0db0fch,0ffh,'IV',0db0ffh,0ffh,'I',0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Test codetest:mvic,10; read string from consolelxid,dgtbufdefcall5lxih,0; convert to integerlxib,dgtbufreaddgt:ldaxbanaajzconvertdadh; hl *= 10movd,hmove,ldadhdadhdaddsui'0'move,amvid,0daddinxbjmpreaddgtconvert:lxib,romanbuf; convert to romancallmkromanmvia,'$'; switch string terminatorstaxbmvic,9; output resultlxid,romanbufjmp5nl:db13,10,'$'dgtbufdef:db5,0dgtbuf:ds6romanbuf:
The main program and test values: 70,1776,2021,3999,4000
movax,0070hcallEncodeRomanmovsi,offsetStringRamcallPrintStringcallNewLinemovax,1776hcallEncodeRomanmovsi,offsetStringRamcallPrintStringcallNewLinemovax,2021hcallEncodeRomanmovsi,offsetStringRamcallPrintStringcallNewLinemovax,3999hcallEncodeRomanmovsi,offsetStringRamcallPrintStringcallNewLinemovax,4000hcallEncodeRomanmovsi,offsetStringRamReturnToDos;macro that calls the int that exits dos
TheEncodeRoman routine:
;ROMAN NUMERALS MODULEEncodeRoman:;takes a BCD value in AX and stores its Roman numeral equivalent in ram.callUnpackBCDcmpdh,03hjngcontinue_EncodeRoman;roman numerals only go up to 3999.jmperrorhandler_encodeRoman_inputTooBigcontinue_EncodeRoman:movsi,offsetStringRam;using SI as destination of roman numerals.pushaxpushcxmovch,0movcl,dh;loop countercmpdh,0jzskipThousandsencodeRoman_handleThousands:moval,"M"mov[ds:si],al;store in string ramincsi; call PrintCharloopencodeRoman_handleThousandsskipThousands:popcxpopaxencodeRoman_HandleHundreds:pushallmovbh,0movbl,dl;use bx as an offset into Roman_Lookup_MasterSHLbl,1SHLbl,1;multiply by 2, we are indexing into a table with 4 bytes per row.movdi,offsetRoman_Lookup_Mastermovcx,4getChar_Hundreds:moval,[bx+es:di];get first char indexpushbxpushdimovdi,offsetRoman_Hundmovbl,almoval,[bx+es:di]cmpal,0jzskipNullChar_RomanHundmov[ds:si],al;store in ramincsi; call PrintCharskipNullChar_RomanHund:popdipopbxincdiloopgetChar_HundredspopallencodeRoman_HandleTens:pushallmovbh,0movbl,ah;use bx as an offset into Roman_Lookup_MasterSHLbl,1SHLbl,1;multiply by 2, we are indexing into a table with 4 bytes per row.movdi,offsetRoman_Lookup_Mastermovcx,4getChar_Tens:moval,[bx+es:di];get first char indexpushbxpushdimovdi,offsetRoman_Tensmovbl,almoval,[bx+es:di]cmpal,0jzskipNullChar_RomanTensmov[ds:si],al;store in ramincsi; call PrintCharskipNullChar_RomanTens:popdipopbxincdiloopgetChar_TenspopallencodeRoman_HandleOnes:pushallmovbh,0movbl,al;use bx as an offset into Roman_Lookup_MasterSHLbl,1SHLbl,1;multiply by 2, we are indexing into a table with 4 bytes per row.movdi,offsetRoman_Lookup_Mastermovcx,4getChar_Ones:moval,[bx+es:di];get first char indexpushbxpushdimovdi,offsetRoman_Onesmovbl,almoval,[bx+es:di]cmpal,0jzskipNullChar_RomanOnesmov[ds:si],al;store in ramincsi; call PrintCharskipNullChar_RomanOnes:popdipopbxincdiloopgetChar_Onespopallmoval,0mov[ds:si],al;place a null terminator at the end of the string.reterrorhandler_encodeRoman_inputTooBig:pushdspushaxLoadSegmentds,ax,@datamoval,01hmovbyteptr[ds:error_code],almovax,offsetEncodeRomanmovwordptr[ds:error_routine],axLoadSegmentds,ax,@codemovsi,offsetRoman_ErrorcallPrintStringpopaxpopdsstc;set carry, allowing program to branch if error occurred.retRoman_Lookup_Masterdb0,0,0,0;0db0,0,0,1;1db0,0,1,1;2db0,1,1,1;3db0,0,1,2;4db0,0,0,2;5db0,0,2,1;6db0,2,1,1;7db2,1,1,1;8db0,0,1,3;9Roman_Onesdb0,"IVX";the same pattern is used regardless of what power of 10 we're working withRoman_Tensdb0,"XLC"Roman_Hunddb0,"CDM"Roman_Errordb"ERROR:BADINPUT",0UnpackBCD:;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.movdx,0movdl,ahmovah,0pushcxmovcl,4roldx,cl;BEFORE: DX = 00XYh;AFTER: DX = 0XY0hrordl,cl;DX = 0X0Yhrolax,cl;BEFORE: AX = 00XYh;AFTER: AX = 0XY0hroral,cl;AX = 0X0Yhpopcxret
Macros used:
pushallmacropushaxpushbxpushcxpushdxpushdspushespushdi;I forgot SI in this macro, but once you add it in the code stops working! So I left it out.endmpopallmacropopdipopespopdspopdxpopcxpopbxpopaxendm
LXXMDCCLXXVIMMXXIMMMCMXCIXERROR: BAD INPUT
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"RETURNPROC 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)=lenRETURNPROC 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) ODRETURNScreenshot from Atari 8-bit computer
1990=MCMXC2008=MMVIII5555=MMMMMDLV1666=MDCLXVI3888=MMMDCCCLXXXVIII3999=MMMCMXCIX
functionarabic2roman(num:Number):String{varlookup: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};varroman:String="",i:String;for(iinlookup){while(num>=lookup[i]){roman+=i;num-=lookup[i];}}returnroman;}trace("1990 in roman is "+arabic2roman(1990));trace("2008 in roman is "+arabic2roman(2008));trace("1666 in roman is "+arabic2roman(1666));
1990 in roman is MCMXC2008 in roman is MMVIII1666 in roman is MDCLXVI
And the reverse:
functionroman2arabic(roman:String):Number{varromanArr:Array=roman.toUpperCase().split('');varlookup:Object={I:1,V:5,X:10,L:50,C:100,D:500,M:1000};varnum:Number=0,val:Number=0;while(romanArr.length){val=lookup[romanArr.shift()];num+=val*(val<lookup[romanArr[0]]?-1:1);}returnnum;}trace("MCMXC in arabic is "+roman2arabic("MCMXC"));trace("MMVIII in arabic is "+roman2arabic("MMVIII"));trace("MDCLXVI in arabic is "+roman2arabic("MDCLXVI"));
MCMXC in arabic is 1990MMVIII in arabic is 2008MDCLXVI in arabic is 1666
withAda.Text_IO;useAda.Text_IO;procedureRoman_Numeral_TestisfunctionTo_Roman(Number:Positive)returnStringissubtypeDigitisIntegerrange0..9;functionRoman(Figure:Digit;I,V,X:Character)returnStringisbegincaseFigureiswhen0=>return"";when1=>return""&I;when2=>returnI&I;when3=>returnI&I&I;when4=>returnI&V;when5=>return""&V;when6=>returnV&I;when7=>returnV&I&I;when8=>returnV&I&I&I;when9=>returnI&X;endcase;endRoman;beginpragmaAssert(Number>=1andNumber<4000);returnRoman(Number/1000,'M',' ',' ')&Roman(Number/100mod10,'C','D','M')&Roman(Number/10mod10,'X','L','C')&Roman(Numbermod10,'I','V','X');endTo_Roman;beginPut_Line(To_Roman(1999));Put_Line(To_Roman(25));Put_Line(To_Roman(944));endRoman_Numeral_Test;
MCMXCIX XXV CMXLIV
[]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)
(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
BEGINPROCEDURE 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.I 1MMMCMXCIX 9MMMDCCCLXXXVIII 15MMIX 4CDV 3
toRoman←{⍝ Digits and corresponding valuesds←((⊢≠⊃)⊆⊢)' M CM D CD C XC L XL X IX V IV I'vs←1000,,100101∘.×9541⍝ Input ≤ 0 is invalid⍵≤0:⎕SIGNAL11{0=d←⊃⍸vs≤⍵:⍬⍝ Find highest digit in number(d⊃ds),∇⍵-d⊃vs⍝ While one exists, add it and subtract from number}⍵}
toRoman¨ 1990 2008 1666 2021 MCMXC MMVIII MDCLXVI MMXXI
(ES6 version)
(mapAccumL version)
------------------ ROMAN INTEGER STRINGS ------------------- roman :: Int -> Stringonroman(n)setkvsto{["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]}scriptstringAddedValueDeductedon|λ|(balance,kv)set{k,v}tokvset{q,r}toquotRem(balance,v)ifq>0then{r,concat(replicate(q,k))}else{r,""}endifend|λ|endscriptconcat(snd(mapAccumL(stringAddedValueDeducted,n,kvs)))endroman--------------------------- TEST -------------------------onrunmap(roman,[2016,1990,2008,2000,1666])--> {"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}endrun---------------- GENERIC LIBRARY FUNCTIONS ----------------- concat :: [[a]] -> [a] | [String] -> Stringonconcat(xs)scriptappendon|λ|(a,b)a&bend|λ|endscriptiflengthofxs>0and¬classof(item1ofxs)isstringthensetunitto""elsesetunitto{}endiffoldl(append,unit,xs)endconcat-- foldl :: (a -> b -> a) -> a -> [b] -> aonfoldl(f,startValue,xs)tellmReturn(f)setvtostartValuesetlngtolengthofxsrepeatwithifrom1tolngsetvto|λ|(v,itemiofxs,i,xs)endrepeatreturnvendtellendfoldl-- map :: (a -> b) -> [a] -> [b]onmap(f,xs)tellmReturn(f)setlngtolengthofxssetlstto{}repeatwithifrom1tolngsetendoflstto|λ|(itemiofxs,i,xs)endrepeatreturnlstendtellendmap-- '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])onmapAccumL(f,acc,xs)scripton|λ|(a,x)tellmReturn(f)tosetpairto|λ|(item1ofa,x)[item1ofpair,(item2ofa)&{item2ofpair}]end|λ|endscriptfoldl(result,[acc,{}],xs)endmapAccumL-- Lift 2nd class handler function into 1st class script wrapper-- mReturn :: Handler -> ScriptonmReturn(f)ifclassoffisscriptthenfelsescriptproperty|λ|:fendscriptendifendmReturn-- quotRem :: Integral a => a -> a -> (a, a)onquotRem(m,n){mdivn,mmodn}endquotRem-- 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]onreplicate(n,a)setoutto{}ifn<1thenreturnoutsetdblto{a}repeatwhile(n>1)if(nmod2)>0thensetouttoout&dblsetnto(ndiv2)setdblto(dbl&dbl)endrepeatreturnout&dblendreplicate-- snd :: (a, b) -> bonsnd(xs)ifclassofxsislistandlengthofxs=2thenitem2ofxselsemissing valueendifendsnd
{"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"}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:0initial:xloopnums'num[d:num\0l:num\1i:0while[i<initial/d][ret:ret++li:i+1]initial:modinitiald]returnret]loop[12345678910111213141516171819202530405060697080909910020030040050060066670080090010001009144416661945199719992000200820102011250030003999]'n->print[n"->"toRomann]
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
MsgBox%stor(444)stor(value){romans=M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,IM:=1000CM:=900D:=500CD:=400C:=100XC:=90L:=50XL:=40X:=10IX:=9V:=5IV:=4I:=1Loop,Parse,romans,`,{While,value>=%A_LoopField%{result.=A_LoopFieldvalue:=value-(%A_LoopField%)}}Returnresult."O"}
(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)
1577 "MDLXXVII" 3999 "MMMCMXCIX"888 "DCCCLXXXVIII" 159 "CLIX"
# syntax: GAWK -f ROMAN_NUMERALS_ENCODE.AWKBEGIN{leng=split("1990 2008 1666",arr," ")for(i=1;i<=leng;i++){n=arr[i]printf("%s = %s\n",n,dec2roman(n))}exit(0)}functiondec2roman(number,v,w,x,y,roman1,roman10,roman100,roman1000){number=int(number)# force to integerif(number<1||number>3999){# number is too small | bigreturn}split("I II III IV V VI VII VIII IX",roman1," ")# 1 2 ... 9split("X XX XXX XL L LX LXX LXXX XC",roman10," ")# 10 20 ... 90split("C CC CCC CD D DC DCC DCCC CM",roman100," ")# 100 200 ... 900split("M MM MMM",roman1000," ")# 1000 2000 3000v=(number-(number%1000))/1000number=number%1000w=(number-(number%100))/100number=number%100x=(number-(number%10))/10y=number%10return(roman1000[v]roman100[w]roman10[x]roman1[y])}
1990 = MCMXC2008 = MMVIII1666 = MDCLXVI
1N=1990:GOSUB5:PRINTN" = "V$2N=2008:GOSUB5:PRINTN" = "V$3N=1666:GOSUB5:PRINTN" = "V$;4END5V=N:V$="":FORI=0TO12:FORL=1TO0STEP0:A=VAL(MID$("1E3900500400100+90+50+40+10+09+05+04+01",I*3+1,3))6L=(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:NEXTL,I7RETURN
REM Roman numerals/EncodeDIMWeights(12)DIMSymbols$(12)DATA1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC",50,"L"DATA40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"REM 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encodedREM with these symbols.FORJ=0TO12READWeights(J)READSymbols$(J)NEXTJAValue=1990GOSUBToRoman:PRINTRoman$REM MCMXCAValue=2022GOSUBToRoman:PRINTRoman$REM MMXXIIAValue=3888GOSUBToRoman:PRINTRoman$REM MMMDCCCLXXXVIIIENDToRoman:REM Result: Roman$Roman$=""I=0Loop:IF(I>12THENExitToRoman:IFAValue<=0THENExitToRoman:WHILEAValue>=Weights(I)Roman$=Roman$+Symbols$(I)AValue=AValue-Weights(I)WENDI=I+1GOTOLoop:ExitToRoman:RETURN
OPTION BASE 1GLOBAL 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$ENDFUNCPRINT toroman$(1990)PRINT toroman$(2008)PRINT toroman$(1666)MCMXCMMVIIIMDCLXVI
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 iend function1666 = MDCLXVI2008 = MMVIII1001 = MI1999 = MCMXCIX
PRINT;1999,FNroman(1999)PRINT;2012,FNroman(2012)PRINT;1666,FNroman(1666)PRINT;3888,FNroman(3888)ENDDEFFNroman(n%)LOCALi%,r$,arabic%(),roman$()DIMarabic%(12),roman$(12)arabic%()=1,4,5,9,10,40,50,90,100,400,500,900,1000roman$()="I","IV","V","IX","X","XL","L","XC","C","CD","D","CM","M"FORi%=12TO0STEP-1WHILEn%>=arabic%(i%)r$+=roman$(i%)n%-=arabic%(i%)ENDWHILENEXT=r$
1999 MCMXCIX2012 MMXII1666 MDCLXVI3888 MMMDCCCLXXXVIII
A version that does not need 32-bit BASIC, with a different approach, with range checks:
PRINT1999;" ";FNint_ToRoman(1999)PRINT2012;" ";FNint_ToRoman(2012)PRINT1666;" ";FNint_ToRoman(1666)PRINT3888;" ";FNint_ToRoman(3888)ENDDEFFNint_ToRoman(A%)IFA%<0:="MINIMUS"IFA%=0:="NULLA"IFA%>3999:="MAXIMUS"A$=STRING$(A%DIV1000,"M"):A%=A%MOD1000IFA%>899:A$=A$+"CM":A%=A%-900IFA%>499:A$=A$+"D":A%=A%-500IFA%>399:A$=A$+"CD":A%=A%-400A$=A$+STRING$(A%DIV100,"C"):A%=A%MOD100IFA%>89:A$=A$+"XC":A%=A%-90IFA%>49:A$=A$+"L":A%=A%-50IFA%>39:A$=A$+"XL":A%=A%-40A$=A$+STRING$(A%DIV10,"X"):A%=A%MOD10IFA%>8:A$=A$+"IX":A%=A%-9IFA%>4:A$=A$+"V":A%=A%-5IFA%>3:A$=A$+"IV":A%=A%-4=A$+STRING$(A%,"I")
1999 MCMXCIX 2012 MMXII 1666 MDCLXVI 3888 MMMDCCCLXXXVIII
100cls110dimarabic(12),roman$(12)120forj=0to12:readarabic(j),roman$(j):nextj130data1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC"140data50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"187avalor=1990:printavalor"= ";:gosub220:printroman$' MCMXC188avalor=2008:printavalor"= ";:gosub220:printroman$' MMXXII189avalor=1666:printavalor"= ";:gosub220:printroman$' MDCLXVI200end210remEncodetoRoman220roman$="":i=0230while(i<=12)and(avalor>0)240whileavalor>=arabic(i)250roman$=roman$+roman$(i)260avalor=avalor-arabic(i)270wend280i=i+1290wend300return
1990 = MCMXC2008 = MMVIII1666 = MDCLXVI
C-128 version:
100DIMRN$(12),NV(12)110FORI=0TO12120:READRN$(I),NV(I)130NEXTI140DATAM,1000,CM,900,D,500,CD,400150DATAC,100,XC,90,L,50,XL,40160DATAX,10,IX,9,V,5,IV,4170DATAI,1180PRINTCHR$(19);CHR$(19);CHR$(147);CHR$(18);190PRINT"***** ROMAN NUMERAL ENCODER *****";CHR$(27);"T"200DO210:PRINT"ENTER NUMBER (0 TO QUIT):";220:OPEN1,0:INPUT#1,AN$:CLOSE1:PRINT230:AN=VAL(AN$):IFAN=0THENEXIT240:RN$=""250:DOWHILEAN>0260:FORI=0TO12270:IFAN>=NV(I)THENBEGIN280:RN$=RN$+RN$(I)290:AN=AN-NV(I)300:GOTO330310:BEND320:NEXTI330:LOOP340:PRINTRN$;CHR$(13)350LOOP
C-16/116/Plus-4 version (BASIC 3.5 has DO/LOOP but not BEGIN/BEND)
100DIMRN$(12),NV(12)110FORI=0TO12120:READRN$(I),NV(I)130NEXTI140DATAM,1000,CM,900,D,500,CD,400150DATAC,100,XC,90,L,50,XL,40160DATAX,10,IX,9,V,5,IV,4170DATAI,1180PRINTCHR$(19);CHR$(19);CHR$(147);CHR$(18);190PRINT"***** ROMAN NUMERAL ENCODER *****";CHR$(27);"T"200DO210:PRINT"ENTER NUMBER (0 TO QUIT):";220:OPEN1,0:INPUT#1,AN$:CLOSE1:PRINT230:AN=VAL(AN$):IFAN=0THENEXIT240:RN$=""250:DOWHILEAN>0260:FORI=0TO12270:IFAN<NV(I)THEN320280:RN$=RN$+RN$(I)290:AN=AN-NV(I)300:I=12320:NEXTI330:LOOP340:PRINTRN$;CHR$(13)350LOOP
This version works on any Commodore, though the title banner should be adjusted to match the color and screen width of the particular machine.
100DIMRN$(12),NV(12)110FORI=0TO12120:READRN$(I),NV(I)130NEXTI140DATAM,1000,CM,900,D,500,CD,400150DATAC,100,XC,90,L,50,XL,40160DATAX,10,IX,9,V,5,IV,4170DATAI,1180PRINTCHR$(19);CHR$(19);CHR$(147);CHR$(18);190PRINT"***** ROMAN NUMERAL ENCODER *****";200REM BEGIN MAIN LOOP210:PRINT"NUMBER (0 TO QUIT):";220:OPEN1,0:INPUT#1,AN$:CLOSE1:PRINT230:AN=VAL(AN$):IFAN=0THENEND240:RN$=""250:IFAN<=0THEN340260:FORI=0TO12270:IFAN<NV(I)THEN320280:RN$=RN$+RN$(I)290:AN=AN-NV(I)300:I=12320:NEXTI330:GOTO250340:PRINTRN$;CHR$(13)350GOTO210
The output is the same for all the above versions:
***** ROMAN NUMERAL ENCODER *****ENTER NUMBER (0 TO QUIT):2009MMIXENTER NUMBER (0 TO QUIT):1666MDCLXVIENTER NUMBER (0 TO QUIT):3888MMMDCCCLXXXVIIIENTER NUMBER (0 TO QUIT):0READY.
DIMSHAREDarabic(0TO12)ASInteger=>{1000,900,500,400,100,90,50,40,10,9,5,4,1}DIMSHAREDroman(0TO12)ASString*2=>{"M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"}FUNCTIONtoRoman(valueASInteger)ASStringDIMiASIntegerDIMresultASStringFORi=0TO12DOWHILEvalue>=arabic(i)result=result+roman(i)value=value-arabic(i)LOOPNEXTitoRoman=resultENDFUNCTION'TestingPRINT"2009 = ";toRoman(2009)PRINT"1666 = ";toRoman(1666)PRINT"3888 = ";toRoman(3888)
2009 = MMIX 1666 = MDCLXVI 3888 = MMMDCCCLXXXVIII
Another solution:
' FB 1.05.0 Win64FunctionromanEncode(nAsInteger)AsStringIfn<1OrElsen>3999ThenReturn""'' can only encode numbers in range 1 to 3999Dimroman1(0To2)AsString={"MMM","MM","M"}Dimroman2(0To8)AsString={"CM","DCCC","DCC","DC","D","CD","CCC","CC","C"}Dimroman3(0To8)AsString={"XC","LXXX","LXX","LX","L","XL","XXX","XX","X"}Dimroman4(0To8)AsString={"IX","VIII","VII","VI","V","IV","III","II","I"}DimAsIntegerthousands,hundreds,tens,unitsthousands=n\1000nMod=1000hundreds=n\100nMod=100tens=n\10units=nMod10DimromanAsString=""Ifthousands>0Thenroman+=roman1(3-thousands)Ifhundreds>0Thenroman+=roman2(9-hundreds)Iftens>0Thenroman+=roman3(9-tens)Ifunits>0Thenroman+=roman4(9-units)ReturnromanEndFunctionDima(2)AsInteger={1990,2008,1666}ForiAsInteger=0To2Printa(i);" => ";romanEncode(a(i))NextPrintPrint"Press any key to quit"Sleep
1990 => MCMXC 2008 => MMVIII 1666 => MDCLXVI
window 1local 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 = resultprint "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 = MCMXC2008 = MMVIII2016 = MMXVI1666 = MDCLXVI3888 = MMMDCCCLXXXVIII1914 = MCMXIV1000 = M 513 = DXIII 33 = XXXIII
PublicSubMain()'TestingPrint"2009 = ";toRoman(2009)Print"1666 = ";toRoman(1666)Print"3888 = ";toRoman(3888)EndFunctiontoRoman(valueAsInteger)AsStringDimresultAsStringDimarabicAsInteger[]=[1000,900,500,400,100,90,50,40,10,9,5,4,1]DimromanAsString[]=["M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"]ForiAsInteger=0Toarabic.MaxDoWhilevalue>=arabic[i]result&=roman[i]value-=arabic[i]LoopNextReturnresultEndFunction
Same as FreeBASIC entry.
10REM Roman numerals/Encode20DIMWEIGHTS%(12),SYMBOLS$(12)30FORJ%=0TO12:READWEIGHTS%(J%),SYMBOLS$(J%):NEXTJ%40DATA1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC"50DATA50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"60REM 3888 or MMMDCCCLXXXVIII (15 chars) is70REM the longest string properly encoded80REM with these symbols.90AVALUE%=1990:GOSUB1000:PRINTROMAN$' MCMXC100AVALUE%=2022:GOSUB1000:PRINTROMAN$' MMXXII110AVALUE%=3888:GOSUB1000:PRINTROMAN$' MMMDCCCLXXXVIII120END990REM Encode to roman1000ROMAN$="":I%=01010WHILE(I%<=12)AND(AVALUE%>0)1020WHILEAVALUE%>=WEIGHTS%(I%)1030ROMAN$=ROMAN$+SYMBOLS$(I%)1040AVALUE%=AVALUE%-WEIGHTS%(I%)1050WEND1060I%=I%+11070WEND1080RETURN
MCMXCMMXXIIMMMDCCCLXXXVIII
100 PROGRAM "Roman.bas"110 DO 120 PRINT :INPUT PROMPT "Enter an arabic number: ":N130 IF N<1 THEN EXIT DO140 PRINT TOROMAN$(N)150 LOOP 160 DEF TOROMAN$(X)170 IF X>3999 THEN180 LET TOROMAN$="Too big."190 EXIT DEF200 END IF 210 RESTORE 220 LET SUM$=""230 FOR I=1 TO 13240 READ ARABIC,ROMAN$250 DO WHILE X>=ARABIC260 LET SUM$=SUM$&ROMAN$270 LET X=X-ARABIC280 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"
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) endfunction 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 MMIX1666 MDCLXVI3888 MMMDCCCLXXXVIII
arabicNumeral = 1990ConvertToRoman() TextWindow.WriteLine(romanNumeral) 'MCMXCarabicNumeral = 2018ConvertToRoman() TextWindow.WriteLine(romanNumeral) 'MMXVIIIarabicNumeral = 3888ConvertToRoman() 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 EndWhileEndSub
MCMXCMMXVIIIMMMDCCCLXXXVIII
10REM Roman numerals/Encode20DIMWEIGHTS(12),SYMBOLS$(12)30FORI=0TO1240READWEIGHTS(I),SYMBOLS$(I)50NEXTI60DATA1000,M,900,CM,500,D,400,CD,100,C,90,XC70DATA50,L,40,XL,10,X,9,IX,5,V,4,IV,1,I80REM ** 3888 or MMMDCCCLXXXVIII (15 chars) is90REM the longest string properly encoded100REM with these symbols.110V=1990:GOSUB500120PRINTROMAN$:REMMCMXC130V=2022:GOSUB500140PRINTROMAN$:REMMMXXII150V=3888:GOSUB500160PRINTROMAN$:REMMMMDCCCLXXXVIII170END490REM ** Encode to roman500ROMAN$=""510I=0520IFI>12ORV<=0THENRETURN530IFV<WEIGHTS(I)THEN570540ROMAN$=ROMAN$+SYMBOLS$(I)550V=V-WEIGHTS(I)560GOTO530570I=I+1580GOTO520590RETURN
MCMXCMMXXIIMMMDCCCLXXXVIII
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 = resultEND FUNCTIONFUNCTION PBMAIN 'Testing ? "2009 = " & toRoman(2009) ? "1666 = " & toRoman(1666) ? "3888 = " & toRoman(3888)END FUNCTION
#SymbolCount=12;0basedcountDataSectiondenominations:Data.s"M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I";0-12denomValues:Data.i1000,900,500,400,100,90,50,40,10,9,5,4,1;valuesindecendingsequentialorderEndDataSection;-setupStructureromanNumeralsymbol.svalue.iEndStructureGlobalDimrefRomanNum.romanNumeral(#SymbolCount)RestoredenominationsFori=0To#SymbolCountRead.srefRomanNum(i)\symbolNextRestoredenomValuesFori=0To#SymbolCountReadrefRomanNum(i)\valueNextProcedure.sdecRoman(n);convertsadecimalnumbertoaromannumeralProtectedroman$,iFori=0To#SymbolCountRepeatIfn>=refRomanNum(i)\valueroman$+refRomanNum(i)\symboln-refRomanNum(i)\valueElseBreakEndIfForEverNextProcedureReturnroman$EndProcedureIfOpenConsole()PrintN(decRoman(1999));MCMXCIXPrintN(decRoman(1666));MDCLXVIPrintN(decRoman(25));XXVPrintN(decRoman(954));CMLIVPrint(#CRLF$+#CRLF$+"Press ENTER to exit")Input()CloseConsole()EndIf
DIMSHAREDarabic(0TO12)DIMSHAREDroman$(0TO12)FUNCTIONtoRoman$(value)LETresult$=""FORi=0TO12DOWHILEvalue>=arabic(i)LETresult$=result$+roman$(i)LETvalue=value-arabic(i)LOOPNEXTitoRoman$=result$ENDFUNCTIONFORi=0TO12READarabic(i),roman$(i)NEXTiDATA1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC"DATA50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"'TestingPRINT"2009 = ";toRoman$(2009)PRINT"1666 = ";toRoman$(1666)PRINT"3888 = ";toRoman$(3888)
[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 wendnext iEND FUNCTION
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
OPTION BASE0DIMarabic(12),roman$(12)FORi=0to12READarabic(i),roman$(i)NEXTiDATA1000,"M",900,"CM",500,"D",400,"CD",100,"C",90,"XC"DATA50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"FUNCTIONtoRoman$(value)LETresult$=""FORi=0TO12DOWHILEvalue>=arabic(i)LETresult$=result$&roman$(i)LETvalue=value-arabic(i)LOOPNEXTiLETtoRoman$=result$ENDFUNCTION!TestingPRINT"2009 = ";toRoman$(2009)PRINT"1666 = ";toRoman$(1666)PRINT"3888 = ";toRoman$(3888)END
Push 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000 ' Initialize arrayFor i = 12 To 0 Step -1 @(i) = Pop()Next ' Calculate and print numbersPrint 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 lineReturn ' 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"; : Return100 Print "CD"; : Return110 Print "D"; : Return120 Print "CM"; : Return130 Print "M"; : Return
FunctiontoRoman(value)AsStringDimarabicAsVariantDimromanAsVariantarabic=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")DimiAsInteger,resultAsStringFori=0To12DoWhilevalue>=arabic(i)result=result+roman(i)value=value-arabic(i)LoopNextitoRoman=resultEndFunctionSubMain()MsgBoxtoRoman(Val(InputBox("Number, please")))EndSub
PROGRAM"romanenc"VERSION"0.0000"DECLAREFUNCTIONEntry()INTERNALFUNCTIONToRoman$(aValue%%)' 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded with these symbols.FUNCTIONEntry()PRINTToRoman$(1990)' MCMXCPRINTToRoman$(2018)' MMXVIIIPRINTToRoman$(3888)' MMMDCCCLXXXVIIIENDFUNCTIONFUNCTIONToRoman$(aValue%%)DIMweights%%[12]DIMsymbols$[12]weights%%[0]=1000weights%%[1]=900weights%%[2]=500weights%%[3]=400weights%%[4]=100weights%%[5]=90weights%%[6]=50weights%%[7]=40weights%%[8]=10weights%%[9]=9weights%%[10]=5weights%%[11]=4weights%%[12]=1symbols$[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@@=0DOWHILE(i@@<=12)AND(aValue%%>0)DOWHILEaValue%%>=weights%%[i@@]destination$=destination$+symbols$[i@@]aValue%%=aValue%%-weights%%[i@@]LOOPi@@=i@@+1LOOPRETURNdestination$ENDFUNCTIONENDPROGRAM
MCMXCMMXVIIIMMMDCCCLXXXVIII
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
10DATA1000,"M",900,"CM"20DATA500,"D",400,"CD"30DATA100,"C",90,"XC"40DATA50,"L",40,"XL"50DATA10,"X",9,"IX"60DATA5,"V",4,"IV",1,"I"70INPUT"Enter an arabic number: ";V80LETVALUE=V90LETV$=""100FORI=0TO12110READA,R$120IFV<ATHENGOTO160130LETV$=V$+R$140LETV=V-A150GOTO120160NEXTI170PRINTVALUE;"=";V$
@echo offsetlocal enabledelayedexpansionsetcnt=0&for%%Ain(1000,900,500,400,100,90,50,40,10,9,5,4,1)do(setarab!cnt!=%%A&set/acnt+=1)setcnt=0&for%%Rin(M,CM,D,CD,C,XC,L,XL,X,IX,V,IV,I)do(setrom!cnt!=%%R&set/acnt+=1)::Testingcall:toRoman 2009echo 2009 =!result!call:toRoman 1666echo 1666 =!result!call:toRoman 3888echo 3888 =!result!pause>nulexit/b 0::The "function"...:toRomansetvalue=%1setresult=for/l%%iin(0,1,12)do(seta=%%icall:add_val)goto:EOF:add_valif!value!lss!arab%a%!goto:EOFsetresult=!result!!rom%a%!set/avalue-=!arab%a%!gotoadd_val
2009 = MMIX1666 = MDCLXVI3888 = MMMDCCCLXXXVIII
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)$)1666 = MDCLXVI2008 = MMVIII1001 = MI1999 = MCMXCIX3888 = MMMDCCCLXXXVIII2021 = MMXXI
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\00g>\20p>:10p00g\#v_20gv>2+v^-1g01\g5+8<^+9_IVXLCDM
1666MDCLXVI
⟨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⋆↕3R⇐{𝕨𝕊0:"";(⊑⟜ds∾·𝕊𝕩-⊑⟜vs)1-˜⊑vs⍋𝕩}}
ToRoman¨ 1990‿2008‿1666‿2021⟨ "MCMXC" "MMVIII" "MDCLXVI" "MMXXI" ⟩
( ( 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") ) ));1990 MCMXC2008 MMVIII1666 MDCLXVI3888 MMMDCCCLXXXVIII3999 MMMCMXCIXCan't convert 4000 to Roman numeral
This solution is a smart but does not return the number written as a string.
#include<stdio.h>intmain(){intarabic[]={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.//charroman[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"};intN;printf("Enter arabic number:\n");scanf("%d",&N);printf("\nRoman number:\n");for(inti=0;i<13;i++){while(N>=arabic[i]){printf("%s",roman[i]);N-=arabic[i];}}return0;}
Enter arabic number:215Roman number:CCXV
#define _CRT_SECURE_NO_WARNINGS#include<stdio.h>#include<string.h>intRomanNumerals_parseInt(constchar*string){intvalue;returnscanf("%u",&value)==1&&value>0?value:0;}constchar*RomanNumerals_toString(intvalue){#define ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE 64staticbuffer[ROMAN_NUMERALS_MAX_OUTPUT_STRING_SIZE];conststaticintmaxValue=5000;conststaticintminValue=1;conststaticstructDigit{charstring[4];// It's better to use 4 than 3 (aligment).intvalue;}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){structDigit*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++;}}returnbuffer;}intmain(intargc,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");intnumbers[]={1,2,3,4,5,6,7,8,9,10,1498,2022};for(inti=0;i<sizeof(numbers)/sizeof(int);i++){printf("%4d = %s\n",numbers[i],RomanNumerals_toString(numbers[i]));}}else{for(inti=1;i<argc;i++){intnumber=RomanNumerals_parseInt(argv[i]);if(number){puts(RomanNumerals_toString(number));}else{puts("???");}}}return0;}
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 = X1498 = MCDXCVIII2022 = MMXXII
usingSystem;classProgram{staticuint[]nums={1000,900,500,400,100,90,50,40,10,9,5,4,1};staticstring[]rum={"M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"};staticstringToRoman(uintnumber){stringvalue="";for(inti=0;i<nums.Length&&number!=0;i++){while(number>=nums[i]){number-=nums[i];value+=rum[i];}}returnvalue;}staticvoidMain(){for(uintnumber=1;number<=1<<10;number*=2){Console.WriteLine("{0} = {1}",number,ToRoman(number));}}}
One-liner Mono REPL
Func<int,string>toRoman=(number)=>newDictionary<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(newstring('I',number),(m,_)=>m.Replace(newstring('I',_.Key),_.Value));
1 = I2 = II4 = IV8 = VIII16 = XVI32 = XXXII64 = LXIV128 = CXXVIII256 = CCLVI512 = DXII1024 = MXXIV
#include<iostream>#include<string>std::stringto_roman(intvalue){structromandata_t{intvalue;charconst*numeral;};staticromandata_tconstromandata[]={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 markerstd::stringresult;for(romandata_tconst*current=romandata;current->value>0;++current){while(value>=current->value){result+=current->numeral;value-=current->value;}}returnresult;}intmain(){for(inti=1;i<=4000;++i){std::cout<<to_roman(i)<<std::endl;}}
#include<iostream>#include<string>std::stringto_roman(intx){if(x<=0)return"Negative or zero!";autoroman_digit=[](charone,charfive,charten,intx){if(x<=3)returnstd::string().assign(x,one);if(x<=5)returnstd::string().assign(5-x,one)+five;if(x<=8)returnfive+std::string().assign(x-5,one);returnstd::string().assign(10-x,one)+ten;};if(x>=1000)returnx-1000>0?"M"+to_roman(x-1000):"M";if(x>=100){autos=roman_digit('C','D','M',x/100);returnx%100>0?s+to_roman(x%100):s;}if(x>=10){autos=roman_digit('X','L','C',x/10);returnx%10>0?s+to_roman(x%10):s;}returnroman_digit('I','V','X',x);}intmain(){for(inti=0;i<2018;i++)std::cout<<i<<" --> "<<to_roman(i)<<std::endl;}
sharedvoidrun(){classNumeral(sharedCharacterchar,sharedIntegerint){}valuetiers=[[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)]];StringtoRoman(Integerhindu,IntegertierIndex=2){assert(existstier=tiers[tierIndex]);" Finds if it's a two character numeral like iv, ix, xl, xc, cd and cm."functionfindTwoCharacterNumeral()=>if(existsbigNum=tier.rest.find((numeral)=>numeral.int-tier.first.int<=hindu<numeral.int))then[tier.first,bigNum]elsenull;if(hindu<=0){// if it's zero then we are done!return"";}elseif(exists[smallNum,bigNum]=findTwoCharacterNumeral()){valuetwoCharSymbol="``smallNum.char````bigNum.char``";valuetwoCharValue=bigNum.int-smallNum.int;return"``twoCharSymbol````toRoman(hindu - twoCharValue, tierIndex)``";}elseif(existsnum=tier.reversed.find((Numeralelem)=>hindu>=elem.int)){return"``num.char````toRoman(hindu - num.int, tierIndex)``";}else{// nothing was found so move to the next smaller tier!returntoRoman(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");}
The easiest way is to use the built-in cl-format function
(defarabic->roman(partialclojure.pprint/cl-formatnil"~@R"))(arabic->roman147);"CXXIII"(arabic->roman99);"XCIX"
Alternatively:
(defroman-map(sorted-map1"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"))(defnint->roman[n]{:pre(integer?n)}(loop[res(StringBuilder.),nn](if-let[v(roman-mapn)](str(.appendresv))(let[[kv](->>roman-mapkeys(filter#(>n%))last(findroman-map))](recur(.appendresv)(-nk))))))(int->roman1999); "MCMXCIX"
An alternate implementation:
(defna2r[a](let[rv'(1000500100501051)rm(zipmaprv"MDCLXVI")dv(->>rv(take-nth2)next#(interleave%%))](loop[aarvrvdvdvrnil](if(<=a0)r(let[v(firstrv)d(or(firstdv)0)l(-vd)](cond(=av)(strr(rmv))(=al)(strr(rmd)(rmv))(and(>av)(>al))(recur(-av)rvdv(strr(rmv)))(and(<av)(<al))(recura(restrv)(restdv)r):else(recur(-al)(restrv)(restdv)(strr(rmd)(rmv)))))))))
Usage:
(a2r1666)"MDCLXVI"(mapa2r[1000138945])("M""I""CCCLXXXIX""XLV")
An alternate implementation:
(defroman-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"))(defna2r([r](reduce str(a2rr(keysroman-map))))([rn](when-not(empty?n)(let[e(firstn)v(-re)roman(roman-mape)](cond(<v0)(a2rr(restn))(=v0)(consroman[])(>=ve)(consroman(a2rvn))(<ve)(consroman(a2rv(restn))))))))
Usage:
(a2r1666)"MDCLXVI"(mapa2r[1000138945])("M""I""CCCLXXXIX""XLV")
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 romanstart_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)) endend start_up1666 = MDCLXVI2008 = MMVIII1001 = MI1999 = MCMXCIX3888 = MMMDCCCLXXXVIII2021 = MMXXI
IDENTIFICATIONDIVISION.PROGRAM-ID.TOROMAN.DATA DIVISION.working-storagesection. 01 ws-numberpic 9(4)value0. 01 ws-save-numberpic 9(4). 01 ws-tbl-def. 03fillerpic x(7)value'1000M '. 03fillerpic x(7)value'0900CM '. 03fillerpic x(7)value'0500D '. 03fillerpic x(7)value'0400CD '. 03fillerpic x(7)value'0100C '. 03fillerpic x(7)value'0090XC '. 03fillerpic x(7)value'0050L '. 03fillerpic x(7)value'0040XL '. 03fillerpic x(7)value'0010X '. 03fillerpic x(7)value'0009IX '. 03fillerpic x(7)value'0005V '. 03fillerpic x(7)value'0004IV '. 03fillerpic x(7)value'0001I '. 01fillerredefinesws-tbl-def. 03filleroccurs13timesindexedbyrx.05ws-tbl-divisorpic 9(4).05ws-tbl-roman-chpic x(1)occurs3timesindexedbycx. 01 ocxpic 99. 01 ws-roman. 03ws-roman-chpic x(1)occurs16times.PROCEDUREDIVISION. acceptws-number perform untilws-number=0movews-numbertows-save-number ifws-number>0andws-number<4000initializews-romanmove0toocxperformvaryingrxfrom1by+1untilws-number=0performuntilws-number<ws-tbl-divisor(rx)performvaryingcxfrom1by+1untilws-tbl-roman-ch(rx,cx)=spacescomputeocx=ocx+1movews-tbl-roman-ch(rx,cx)tows-roman-ch(ocx)end-performcomputews-number=ws-number-ws-tbl-divisor(rx)end-performend-performdisplay'inp='ws-save-number' roman='ws-roman elsedisplay'inp='ws-save-number' invalid' end-if acceptws-number end-perform.
(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 invalidinp=3333 roman=MMMCCCXXXIII inp=3888 roman=MMMDCCCLXXXVIII inp=3999 roman=MMMCMXCIX inp=3345 roman=MMMCCCXLV
decimal_to_roman=(n) -># This should work for any positive integer, although it# gets a bit preposterous for large numbers.ifn>=4000thousands=decimal_to_romann/1000ones=decimal_to_romann%1000return"M(#{thousands})#{ones}"s=''translate_each=(min, roman) ->whilen>=minn-=mins+=romantranslate_each1000,"M"translate_each900,"CM"translate_each500,"D"translate_each400,"CD"translate_each100,"C"translate_each90,"XC"translate_each50,"L"translate_each40,"XL"translate_each10,"X"translate_each9,"IX"translate_each5,"V"translate_each4,"IV"translate_each1,"I"s###################tests=IV:4XLII:42MCMXC:1990MMVIII:2008MDCLXVI:1666'M(IV)':4000'M(VI)IX':6009'M(M(CXXIII)CDLVI)DCCLXXXIX':123456789'M(MMMV)I':3005001forexpected,decimaloftestsroman=decimal_to_roman(decimal)ifroman==expectedconsole.log"#{decimal} =#{roman}"elseconsole.log"error for#{decimal}:#{roman} is wrong"
(defunroman-numeral(n)(formatnil"~@R"n))
include "cowgol.coh";include "argv.coh";# Encode the given number as a Roman numeralsub 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 stringend sub;# Read numbers from the command line and print the corresponding Roman numeralsArgvInit();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;$ ./romanenc.386 1990 2008 1666MCMXCMMVIIIMDCLXVI
stringtoRoman(intn)purenothrowin{assert(n<5000);}body{staticimmutableweights=[1000,900,500,400,100,90,50,40,10,9,5,4,1];staticimmutablesymbols=["M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"];stringroman;foreach(i,w;weights){while(n>=w){roman~=symbols[i];n-=w;}if(n==0)break;}returnroman;}unittest{assert(toRoman(455)=="CDLV");assert(toRoman(3456)=="MMMCDLVI");assert(toRoman(2488)=="MMCDLXXXVIII");}voidmain(){}
programRomanNumeralsEncode;{$APPTYPE CONSOLE}functionIntegerToRoman(aValue:Integer):string;vari:Integer;constWEIGHTS:array[0..12]ofInteger=(1000,900,500,400,100,90,50,40,10,9,5,4,1);SYMBOLS:array[0..12]ofstring=('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');beginfori:=Low(WEIGHTS)toHigh(WEIGHTS)dobeginwhileaValue>=WEIGHTS[i]dobeginResult:=Result+SYMBOLS[i];aValue:=aValue-WEIGHTS[i];end;ifaValue=0thenBreak;end;end;beginWriteln(IntegerToRoman(1990));// MCMXCWriteln(IntegerToRoman(2008));// MMVIIIWriteln(IntegerToRoman(1666));// MDCLXVIend.
proc toroman(word n; *char buf) *char: *char parts = "M\e\eCM\eD\e\eCD\eC\e\eXC\eL\e\eXL\eX\e\eIX\eV\e\eIV\eI"; [13]word sizes = (1000,900,500,400,100,90,50,40,10,9,5,4,1); channel output text roman; word part; open(roman, buf); while n > 0 do part := 0; while sizes[part]>n do part := part+1 od; write(roman; parts + 3*part); n := n - sizes[part] od; close(roman); bufcorpproc test(word n) void: [32]char buf; writeln(n, ": ", toroman(n, &buf[0]))corpproc main() void: test(1666); test(2008); test(1001); test(1999); test(3888); test(2025)corp
1666: MDCLXVI2008: MMVIII1001: MI1999: MCMXCIX3888: MMMDCCCLXXXVIII2025: MMXXV
constweights=[1000,900,500,400,100,90,50,40,10,9,5,4,1];constsymbols=["M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I"];functiontoRoman(n:Integer):String;vari,w:Integer;beginfori:=0toweights.Highdobeginw:=weights[i];whilen>=wdobeginResult+=symbols[i];n-=w;end;ifn=0thenBreak;end;end;PrintLn(toRoman(455));PrintLn(toRoman(3456));PrintLn(toRoman(2488));
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 1990print dec2rom 2008print dec2rom 1666
RomanEncode(UNSIGNEDInt):=FUNCTIONSetWeights:=[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:=RECORDUNSIGNEDval;STRINGRoman;END;dsWeights:=DATASET(13,TRANSFORM(ProcessRec,SELF.val:=Int,SELF:=[]));SymbolStr(i,n,STRINGs):=CHOOSE(n+1,'',SetSymbols[i],SetSymbols[i]+SetSymbols[i],SetSymbols[i]+SetSymbols[i]+SetSymbols[i],s);RECORDOF(dsWeights)XF(dsWeightsL,dsWeightsR,INTEGERC):=TRANSFORMThisVal:=IF(C=1,R.Val,L.Val);IsDone:=ThisVal=0;SELF.Roman:=IF(IsDone,L.Roman,L.Roman+SymbolStr(C,ThisValDIVSetWeights[C],L.Roman));SELF.val:=IF(IsDone,0,ThisVal-((ThisValDIVSetWeights[C])*SetWeights[C]));END;i:=ITERATE(dsWeights,XF(LEFT,RIGHT,COUNTER));RETURNi[13].Roman;END;RomanEncode(1954);//MCMLIVRomanEncode(1990);//MCMXCRomanEncode(2008);//MMVIIIRomanEncode(1666);//MDCLXVI
Hg/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///,pQclassAPPLICATIONcreatemakefeature{NONE}-- Initializationmakelocalnumbers:ARRAY[INTEGER]donumbers:=<<1990,2008,1666,3159,1977,2010>>-- "MCMXC", "MMVIII", "MDCLXVI", "MMMCLIX", "MCMLXXVII", "MMX"acrossnumbersasnloopprint(n.item.out+" in decimal Arabic numerals is "+decimal_to_roman(n.item)+" in Roman numerals.%N")endendfeature-- Roman numeralsdecimal_to_roman(a_int:INTEGER):STRING-- Representation of integer `a_int' as Roman numeralrequirea_int>0localdnums:ARRAY[INTEGER]rnums:ARRAY[STRING]dnum:INTEGERrnum:STRINGi:INTEGERdodnums:=<<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_intrnum:=""fromi:=1untili>dnums.countordnum<=0loopfromuntildnum<dnums[i]loopdnum:=dnum-dnums[i]rnum:=rnum+rnums[i]endi:=i+1endResult:=rnumendend
open number string mathdigit 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' xmap (join "" << toRoman) [1999,25,944]
["MCMXCIX","XXV","CMXLIV"]
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())}1990 : MCMXC2008 : MMVIII1666 : MDCLXVI
defmoduleRoman_numeraldodefencode(0),do:''defencode(x)whenx>=1000,do:[?M|encode(x-1000)]defencode(x)whenx>=100,do:digit(div(x,100),?C,?D,?M)++encode(rem(x,100))defencode(x)whenx>=10,do:digit(div(x,10),?X,?L,?C)++encode(rem(x,10))defencode(x)whenx>=1,do:digit(x,?I,?V,?X)defpdigit(1,x,_,_),do:[x]defpdigit(2,x,_,_),do:[x,x]defpdigit(3,x,_,_),do:[x,x,x]defpdigit(4,x,y,_),do:[x,y]defpdigit(5,_,y,_),do:[y]defpdigit(6,x,y,_),do:[y,x]defpdigit(7,x,y,_),do:[y,x,x]defpdigit(8,x,y,_),do:[y,x,x,x]defpdigit(9,x,_,z),do:[x,z]end
Another:
defmoduleRoman_numeraldo@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'}]defencode(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)endend
Test:
Enum.each([1990,2008,1666],fnn->IO.puts"#{n}:#{Roman_numeral.encode(n)}"end)
1990: MCMXC2008: MMVIII1666: MDCLXVI
(defunar2ro(AN)"Translate from arabic number AN to roman number. For example, (ar2ro 1666) returns (M D C L X V I)."(cond((>=AN1000)(cons'M(ar2ro(-AN1000))))((>=AN900)(cons'C(cons'M(ar2ro(-AN900)))))((>=AN500)(cons'D(ar2ro(-AN500))))((>=AN400)(cons'C(cons'D(ar2ro(-AN400)))))((>=AN100)(cons'C(ar2ro(-AN100))))((>=AN90)(cons'X(cons'C(ar2ro(-AN90)))))((>=AN50)(cons'L(ar2ro(-AN50))))((>=AN40)(cons'X(cons'L(ar2ro(-AN40)))))((>=AN10)(cons'X(ar2ro(-AN10))))((>=AN5)(cons'V(ar2ro(-AN5))))((>=AN4)(cons'I(cons'V(ar2ro(-AN4)))))((>=AN1)(cons'I(ar2ro(-AN1))))((=AN0)nil)))
-module(roman).-export([to_roman/1]).to_roman(0)->[];to_roman(X)whenX>=1000->[$M|to_roman(X-1000)];to_roman(X)whenX>=100->digit(Xdiv100,$C,$D,$M)++to_roman(Xrem100);to_roman(X)whenX>=10->digit(Xdiv10,$X,$L,$C)++to_roman(Xrem10);to_roman(X)whenX>=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)whenN>0->#encode_acc{romans=Romans}=lists:foldl(funencode_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)whenN<Value->Acc;encode_from_integer({Roman,Value},#encode_acc{n=N,romans=Romans})->Times=NdivValue,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}].
36> roman_numerals:encode_from_integer( 1990 )."MCMXC"37> roman_numerals:encode_from_integer( 2008 )."MMVIII"38> roman_numerals:encode_from_integer( 1666 )."MDCLXVI"
PROGRAM ARAB2ROMANDIM 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 PROCEDUREBEGIN!!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 PROGRAMconstant 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 resultend functionprintf(1,"%d = %s\n",{2009,toRoman(2009)})printf(1,"%d = %s\n",{1666,toRoman(1666)})printf(1,"%d = %s\n",{3888,toRoman(3888)})2009 = MMIX 1666 = MDCLXVI 3888 = MMMDCCCLXXXVIII
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
letdigitxyz=function1->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"letrecto_romanacc=function|xwhenx>=1000->to_roman(acc+"M")(x-1000)|xwhenx>=100->to_roman(acc+digit"C""D""M"(x/100))(x%100)|xwhenx>=10->to_roman(acc+digit"X""L""C"(x/10))(x%10)|xwhenx>0->acc+digit"I""V""X"x|0->acc|_->failwith"invalid call to_roman (negative input)"letromann=to_roman""n[<EntryPoint>]letmainargs=[1990;2008;1666]|>List.map(funn->romann)|>List.iter(printfn"%s")0
MCMXCMMVIIIMDCLXVI
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-errorn;:roman-range-check(n--n)dup1 10000between?[roman-range-error]unless;:>roman(n--str)roman-range-checkroman-valuesroman-digits[[/modswap]dip<repetition>concat]2map""concat-asnip;
^$." "[$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"]#%
**** converts a number to its roman numeral representation**classRomanNumerals{privateStrdigit(Strx,Stry,Strz,Inti){switch(i){case1:returnxcase2:returnx+xcase3:returnx+x+xcase4:returnx+ycase5:returnycase6:returny+xcase7:returny+x+xcase8:returny+x+x+xcase9:returnx+z}return""}StrtoRoman(Inti){if(i>=1000){return"M"+toRoman(i-1000)}if(i>=100){returndigit("C","D","M",i/100)+toRoman(i%100)}if(i>=10){returndigit("X","L","C",i/10)+toRoman(i%10)}if(i>=1){returndigit("I","V","X",i)}return""}Voidmain(){2000.times|i|{echo("$i =${toRoman(i)}")}}}
:vectorcreate( n -- )0do,loopdoes>( n -- )swapcells+@execute;\ these are ( numerals -- numerals ):,Idupc@C,;:,Vdup1+c@C,;:,Xdup2+c@C,;\ these are ( numerals -- ):noname,I,Xdrop;:noname,V,I,I,Idrop;:noname,V,I,Idrop;:noname,V,Idrop;:noname,Vdrop;:noname,I,Vdrop;:noname,I,I,Idrop;:noname,I,Idrop;:noname,Idrop;'drop( 0 : no output )10vector,digit:roman-rec( numerals n -- )10/moddupif>rover2+r>recurseelsedropthen,digit;:roman( n -- c-addr u )dup04000within0=abort"EXLIMITO!"HERESWAPs"IVXLCDM"dropswaproman-recHEREOVER-;1999romantype\ MCMXCIX25romantype\ XXV944romantype\ CMXLIV
Alternative implementation
createromans0,1,5,21,9,2,6,22,86,13,does>swapcells+@;:roman-digit( a1 n1 a2 n2 -- a3)drop>rromansbegindupwhiletuck4mod1-charsr@+c@overc!char+swap4/repeatr>dropdrop;:(split)swap>r/modr>swap;:>roman( n1 a -- a n2)tuck1000(split)s"M"roman-digit100(split)s"CDM"roman-digit10(split)s"XLC"roman-digit1(split)s"IVX"roman-digitnipover-;create(roman)16charsallot1999(roman)>romantypecr
programroman_numeralsimplicit none write(*,'(a)')roman(2009)write(*,'(a)')roman(1666)write(*,'(a)')roman(3888)containsfunctionroman(n)result(r)implicit noneinteger,intent(in)::ninteger,parameter::d_max=13integer::dinteger::minteger::m_divcharacter(32)::rinteger,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=ndod=1,d_maxm_div=m/d_dec(d)r=trim(r)//repeat(trim(d_rom(d)),m_div)m=m-d_dec(d)*m_divend doend functionromanend programroman_numerals
MMIX MDCLXVI MMMDCCCLXXXVIII
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 likeIVXLCDM. 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...)
packagemainimport"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̅"})funcformatRoman(nint)(string,bool){ifn<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.returnm6[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}funcmain(){// show three numbers mentioned in task descriptionsfor_,n:=range[]int{1990,2008,1666}{r,ok:=formatRoman(n)ifok{fmt.Println(n,"==",r)}else{fmt.Println(n,"not representable")}}}
1990 == MCMXC2008 == MMVIII1666 == MDCLXVI
{[1000 900 500 400 100 90 50 40 10 9 5 4 1]:A; 'M CM D CD C XC L XL X IX V IV I'' '/:R; '':Q; {A{1$>!},0=.A?R=Q\+:Q;-.}do;Q}:roman;1990 roman p2008 roman p1666 roman p"MCMXC""MMVIII""MDCLXVI"
#!/usr/bin/env golosh----This module takes a decimal integer and converts it to a Roman numeral.----moduleRomannumeralsencodeaugmentjava.lang.Integer{functiondigits=|this|{varremaining=thisletdigits=vector[]whileremaining>0{digits:prepend(remaining%10)remaining=remaining/10}returndigits}---- 123: digitsWithPowers() will return [[1, 2], [2, 1], [3, 0]] ----functiondigitsWithPowers=|this|->vector[[this:digits():get(i),(this:digits():size()-1)-i]for(vari=0,i<this:digits():size(),i=i+1)]functionencode=|this|{require(this>0,"the integer must be positive!")letromanPattern=|digit,powerOf10|->match{whendigit==1theniwhendigit==2theni+iwhendigit==3theni+i+iwhendigit==4theni+vwhendigit==5thenvwhendigit==6thenv+iwhendigit==7thenv+i+iwhendigit==8thenv+i+i+iwhendigit==9theni+xotherwise""}with{i,v,x=[["I","V","X"],["X","L","C"],["C","D","M"],["M","?","?"]]:get(powerOf10)}returnvector[romanPattern(digit,power)foreachdigit,powerinthis:digitsWithPowers()]:join("")}}functionmain=|args|{println("1990 == MCMXC?"+(1990:encode()=="MCMXC"))println("2008 == MMVIII?"+(2008:encode()=="MMVIII"))println("1666 == MDCLXVI?"+(1666:encode()=="MDCLXVI"))}
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']defroman(arabic){defresult=""symbols.keySet().sort().reverse().each{while(arabic>=it){arabic-=itresult+=symbols[it]}}returnresult}assertroman(1)=='I'assertroman(2)=='II'assertroman(4)=='IV'assertroman(8)=='VIII'assertroman(16)=='XVI'assertroman(32)=='XXXII'assertroman(25)=='XXV'assertroman(64)=='LXIV'assertroman(128)=='CXXVIII'assertroman(256)=='CCLVI'assertroman(512)=='DXII'assertroman(954)=='CMLIV'assertroman(1024)=='MXXIV'assertroman(1666)=='MDCLXVI'assertroman(1990)=='MCMXC'assertroman(2008)=='MMVIII'
With an explicit decimal digit representation list:
digit::Char->Char->Char->Integer->Stringdigitxyzk=[[x],[x,x],[x,x,x],[x,y],[y],[y,x],[y,x,x],[y,x,x,x],[x,z]]!!(fromIntegerk-1)toRoman::Integer->StringtoRoman0=""toRomanx|x<0=error"Negative roman numeral"toRomanx|x>=1000='M':toRoman(x-1000)toRomanx|x>=100=digit'C''D''M'q++toRomanrwhere(q,r)=x`divMod`100toRomanx|x>=10=digit'X''L''C'q++toRomanrwhere(q,r)=x`divMod`10toRomanx=digit'I''V''X'xmain::IO()main=print$toRoman<$>[1999,25,944]
["MCMXCIX","XXV","CMXLIV"]
or, definingromanFromInt in terms of mapAccumL
importData.Bifunctor(first)importData.List(mapAccumL)importData.Tuple(swap)roman::Int->Stringroman=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->StringromanFromIntnksn=concat.snd$mapAccumLgonnkswheregoa(v,s)=swap$first((>>s).enumFromTo1)$quotRemavmain::IO()main=(putStrLn.unlines)(roman<$>[1666,1990,2008,2016,2018])
MDCLXVIMCMXCMMVIIIMMXVIMMXVIII
With the Roman patterns abstracted, and in a simple logic programming idiom:
moduleMainwhere-------------------------- 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.romanPattern0=[]-- empty stringromanPattern1=[0]-- I or X or C or MromanPattern2=[0,0]-- II or XX...romanPattern3=[0,0,0]-- III...romanPattern4=[0,1]-- IV...romanPattern5=[1]-- ...romanPattern6=[1,0]romanPattern7=[1,0,0]romanPattern8=[1,0,0,0]romanPattern9=[0,2]encodeValue0_=""encodeValuevaluemagnitude=encodeValuerest(magnitude+1)++digitswherelow=remvalue10-- least significant digit (encoded now)rest=divvalue10-- the other digits (to be encoded next)indices=mapaddBase(romanPatternlow)addBasei=i+(2*magnitude)digits=mappickDigitindicespickDigiti=romanDigits!!iencodevalue=encodeValuevalue0-------------------- TEST SUITE --------------------main=dotest"MCMXC"1990test"MMVIII"2008test"MDCLXVI"1666testexpectedvalue=putStrLn((showvalue)++" = "++roman++remark)whereroman=encodevalueremark=" ("++(ifroman==expectedthen"PASS"else("FAIL, expected "++(showexpected)))++")"
1990 = MCMXC (PASS)2008 = MMVIII (PASS)1666 = MDCLXVI (PASS)
CHARACTER Roman*20CALL RomanNumeral(1990, Roman) ! MCMXCCALL RomanNumeral(2008, Roman) ! MMVIIICALL RomanNumeral(1666, Roman) ! MDCLXVIENDSUBROUTINE 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 ENDDOEND
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)==linknumbers# commas, romanproceduremain(arglist)everyx:=!arglistdowrite(commas(x)," -> ",roman(x)|"*** can't convert to Roman numerals ***")end
numbers.icn provides roman as seen below and is based upon a James Gimple SNOBOL4 function.
procedureroman(n)#: convert integer to Roman numerallocalarabic,resultstaticequivinitialequiv:=["","I","II","III","IV","V","VI","VII","VIII","IX"]integer(n)>0|failresult:=""everyarabic:=!ndoresult:=map(result,"IVXLCDM","XLCDM**")||equiv[arabic+1]iffind("*",result)thenfailelsereturnresultend
#roman.exe 3 4 8 49 2010 1666 3000 3999 4000 3 -> III4 -> IV8 -> VIII49 -> XLIX2,010 -> MMX1,666 -> MDCLXVI3,999 -> MMMCMXCIX4,000 -> *** can't convert to Roman numerals ***
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 toinput the numbers as spelled out digitwise in all caps.
PLEASE WRITE IN .1 DO READ OUT .1 DO GIVE UP
$ ./romanONE SIX SIX SIX MDCLXVI
Roman:=Objectclonedo(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,numssize,if(number==0,break)while(number>=numsat(i),number=number-numsat(i)result=result..rumat(i)))returnresult))Romannumeral(1666)println
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:
rfd1234MCCXXXIVrfd567DLXVIIrfd89LXXXIX
Derived from theJ Wiki. Further examples of use will be found there.
The conversion function throws an IllegalArgumentException for non-positive numbers, since Java does not have unsigned primitives.
publicclassRN{enumNumeral{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);intweight;Numeral(intweight){this.weight=weight;}};publicstaticStringroman(longn){if(n<=0){thrownewIllegalArgumentException();}StringBuilderbuf=newStringBuilder();finalNumeral[]values=Numeral.values();for(inti=values.length-1;i>=0;i--){while(n>=values[i].weight){buf.append(values[i]);n-=values[i].weight;}}returnbuf.toString();}publicstaticvoidtest(longn){System.out.println(n+" = "+roman(n));}publicstaticvoidmain(String[]args){test(1999);test(25);test(944);test(0);}}
1999 = MCMXCIX25 = XXV944 = CMXLIVException in thread "main" java.lang.IllegalArgumentExceptionat RN.roman(RN.java:15)at RN.test(RN.java:31)at RN.main(RN.java:38)
importjava.util.Set;importjava.util.EnumSet;importjava.util.Collections;importjava.util.stream.Collectors;importjava.util.stream.LongStream;publicinterfaceRomanNumerals{publicenumNumeral{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);publicfinallongweight;privatestaticfinalSet<Numeral>SET=Collections.unmodifiableSet(EnumSet.allOf(Numeral.class));privateNumeral(longweight){this.weight=weight;}publicstaticNumeralgetLargest(longweight){returnSET.stream().filter(numeral->weight>=numeral.weight).findFirst().orElse(I);}};publicstaticStringencode(longn){returnLongStream.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());}publicstaticlongdecode(Stringroman){longresult=newStringBuilder(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;}returnresult;}publicstaticvoidtest(longn){System.out.println(n+" = "+encode(n));System.out.println(encode(n)+" = "+decode(encode(n)));}publicstaticvoidmain(String[]args){LongStream.of(1999,25,944).forEach(RomanNumerals::test);}}
1999 = MCMXCIXMCMXCIX = 199925 = XXVXXV = 25944 = CMXLIVCMXLIV = 944
varroman={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){varvalue='';for(varidx=0;n>0&&idx<this.map.length;idx+=2){while(n>=this.map[idx]){value+=this.map[idx+1];n-=this.map[idx];}}returnvalue;}}roman.int_to_roman(1999);// "MCMXCIX"
(function(){'use strict';// If the Roman is a string, pass any delimiters through// (Int | String) -> StringfunctionromanTranscription(a){if(typeofa==='string'){varps=a.split(/\d+/),dlm=ps.length>1?ps[1]:undefined;return(dlm?a.split(dlm).map(function(x){returnNumber(x);}):[a]).map(roman).join(dlm);}elsereturnroman(a);}// roman :: Int -> Stringfunctionroman(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){varm=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;}// TESTreturn[2016,1990,2008,"14.09.2015",2000,1666].map(romanTranscription);})();
["MMXVI","MCMXC","MMVIII","XIV.IX.MMXV","MM","MDCLXVI"]
(mapAccumL version)
(()=>{"use strict";// -------------- ROMAN INTEGER STRINGS --------------// roman :: Int -> Stringconstroman=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 ()constmain=()=>([2016,1990,2008,2000,2020,1666].map(roman)).join("\n");// ---------------- GENERIC FUNCTIONS ----------------// Tuple (,) :: a -> b -> (a, b)constTuple=a=>// A pair of values, possibly of// different types.b=>({type:"Tuple","0":a,"1":b,length:2,*[Symbol.iterator](){for(constkinthis){if(!isNaN(k)){yieldthis[k];}}}});// mapAccumL :: (acc -> x -> (acc, y)) -> acc ->// [x] -> (acc, [y])constmapAccumL=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)constremQuot=m=>n=>[m%n,Math.trunc(m/n)];// second :: (a -> b) -> ((c, a) -> (c, b))constsecond=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)]constzip=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 --returnmain();})();
MDCLXVIMCMXCMMVIIIMMXVIMMXVIIIMMXX
functiontoRoman(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));
MDCLXVIWorks with gojq, the Go implementation of jq
The "easy-to-code" version is presented first, followedby the "orders of magnitude" version. Both versionswork 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 outputare identical for both versions and are therefore not repeated.
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)" )
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
Translated fromJulia extended to 399,999
def digits: tostring | explode | map( [.]|implode|tonumber);# Non-negative integer to Roman numeral up to 399,999def 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;This covers both Encode (toRoman) and Decode (fromRoman).
/* Roman numerals, in Jsish */varRoman={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{varn=0;varre=/IV|IX|I|V|XC|XL|X|L|CD|CM|C|D|M/g;varmatches=roman.match(re);if(!matches)returnNaN;for(varhitofmatches)n+=this.val[this.ord.indexOf(hit)];returnn;},toRoman:function(n:number):string{varroman='';varidx=0;while(n>0){while(n>=this.val[idx]){roman+=this.ord[idx];n-=this.val[idx];}idx++;}returnroman;}};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') ==> 8Roman.fromRoman('MMMDIV') ==> 3504Roman.fromRoman('CDIV') ==> 404Roman.fromRoman('MDCLXVI') ==> 1666Roman.fromRoman('not') ==> NaNRoman.toRoman(8) ==> VIIIRoman.toRoman(3504) ==> MMMDIVRoman.toRoman(404) ==> CDIVRoman.toRoman(1666) ==> MDCLXVI=!EXPECTEND!=*/
prompt$ jsish -u Roman.jsi[PASS] Roman.jsi
usingPrintffunctionromanencode(n::Integer)ifn<1||n>4999throw(DomainError())endDR=[["I","X","C","M"]["V","L","D","MMM"]]rnum=""for(omag,d)inenumerate(digits(n))ifd==0omr=""elseifd<4omr=DR[omag,1]^delseifd==4omr=DR[omag,1]*DR[omag,2]elseifd==5omr=DR[omag,2]elseifd<9omr=DR[omag,2]*DR[omag,1]^(d-5)elseomr=DR[omag,1]*DR[omag+1,1]endrnum=omr*rnumendreturnrnumendtestcases=[1990,2008,1668]append!(testcases,rand(1:4999,12))testcases=unique(testcases)println("Test romanencode, arabic => roman:")fornintestcases@printf("%-4i =>%s\n",n,romanencode(n))end
Test romanencode, arabic => roman:1990 => MCMXC2008 => MMVIII1668 => MDCLXVIII2928 => MMCMXXVIII129 => CXXIX4217 => MMMMCCXVII1503 => MDIII2125 => MMCXXV1489 => MCDLXXXIX3677 => MMMDCLXXVII1465 => MCDLXV1421 => MCDXXI1642 => MDCXLII572 => DLXXII3714 => MMMDCCXIV
valromanNumerals=mapOf(1000to"M",900to"CM",500to"D",400to"CD",100to"C",90to"XC",50to"L",40to"XL",10to"X",9to"IX",5to"V",4to"IV",1to"I")funencode(number:Int):String?{if(number>5000||number<1){returnnull}varnum=numbervarresult=""for((multiple,numeral)inromanNumerals.entries){while(num>=multiple){num-=multipleresult+=numeral}}returnresult}funmain(args:Array<String>){println(encode(1990))println(encode(1666))println(encode(2008))}
MCMXCMDCLXVIMMVIII
Alternatively:
funInt.toRomanNumeral():String{fundigit(k:Int,unit:String,five:String,ten:String):String{returnwhen(k){in1..3->unit.repeat(k)4->unit+fivein5..8->five+unit.repeat(k-5)9->unit+tenelse->throwIllegalArgumentException("$k not in range 1..9")}}returnwhen(this){0->""in1..9->digit(this,"I","V","X")in10..99->digit(this/10,"X","L","C")+(this%10).toRomanNumeral()in100..999->digit(this/100,"C","D","M")+(this%100).toRomanNumeral()in1000..3999->"M"+(this-1000).toRomanNumeral()else->throwIllegalArgumentException("${this} not in range 0..3999")}}
definebr=>'\r'// encode romandefineencodeRoman(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)withiin#refdo=>{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)
The macro\Roman is defined for uppercase roman numeral, accepting asargument a name of an existing counter.
\documentclass{minimal}\newcounter{currentyear}\setcounter{currentyear}{\year}\begin{document}Anno Domini\Roman{currentyear}\end{document}
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 repeatreturn romanend toRomanfunction repeatChar c n local cc repeat n times put c after cc end repeat return ccend repeatChar
Examples
toRoman(2009) -- MMIXtoRoman(1666) -- MDCLXVItoRoman(1984) -- MCMLXXXIVtoRoman(3888) -- MMMDCCCLXXXVIII
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) "\)) :numeralsendto digits :n :numerals output word ifelse :n < 10 ["||] [digits int :n/10 bf bf :numerals] ~ digit modulo :n 10 :numeralsendto roman :n if or :n < 0 :n >= 4000 [output [EX MODVS!]] output digits :n [I V X L C D M]endprint roman 1999 ; MCMXCIX print roman 25 ; XXVprint roman 944 ; CMXLIV
HAI 1.2I HAS A Romunz ITZ A BUKKITRomunz 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 BUKKITValuez HAS A SRS 0 ITZ 1000Valuez HAS A SRS 1 ITZ 900Valuez HAS A SRS 2 ITZ 500Valuez HAS A SRS 3 ITZ 400Valuez HAS A SRS 4 ITZ 100Valuez HAS A SRS 5 ITZ 90Valuez HAS A SRS 6 ITZ 50Valuez HAS A SRS 7 ITZ 40Valuez HAS A SRS 8 ITZ 10Valuez HAS A SRS 9 ITZ 9Valuez HAS A SRS 10 ITZ 5Valuez HAS A SRS 11 ITZ 4Valuez HAS A SRS 12 ITZ 1HOW 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 ResultIF U SAY SOVISIBLE SMOOSH 2009 " = " I IZ Romunize YR 2009 MKAY MKAYVISIBLE SMOOSH 1666 " = " I IZ Romunize YR 1666 MKAY MKAYVISIBLE SMOOSH 3888 " = " I IZ Romunize YR 3888 MKAY MKAYKTHXBYE
2009 = MMIX1666 = MDCLXVI3888 = MMMDCCCLXXXVIII
Function toRoman(value) As StringDim arabic(12) As IntegerDim roman(12) As Stringarabic(0) = 1000arabic(1) = 900arabic(2) = 500arabic(3) = 400arabic(4) = 100arabic(5) = 90arabic(6) = 50arabic(7) = 40arabic(8) = 10arabic(9) = 9arabic(10) = 5arabic(11) = 4arabic(12) = 1roman(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 StringFor i = 0 To 12Do While value >= arabic(i)result = result + roman(i)value = value - arabic(i)LoopNext itoRoman = resultEnd Function
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()+0for_,vinipairs(romans)do--note that this is -not- ipairs.val,let=unpack(v)whilek>=valdok=k-valio.write(let)endendprint()
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))')')')')')')')')')')')')')dnldnlroman(3675)
MMMDCLXXV
> for n in [ 1666, 1990, 2008 ] do printf( "%d\t%s\n", n, convert( n, 'roman' ) ) end: 1666 MDCLXVI1990 MCMXC2008 MMVIII
RomanNumeral is a built-in function in the Wolfram language. Examples:
RomanNumeral[4]RomanNumeral[99]RomanNumeral[1337]RomanNumeral[1666]RomanNumeral[6889]
gives back:
IVXCIXMCCCXXXVIIMDCLXVIMMMMMMDCCCLXXXIX
The non-ceremonial work in this program starts at the functionto_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 themain/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 thepromote/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:
build_roman/1 is now called with ['2', '1'].digit_to_roman/1).to_roman/1.It is possible for this to be implemented differently even keeping the same algorithm. For example themap module from the standard library could be used for looking up conversions and promotions instead of havingdigit_to_roman/1 andpromote. 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 themain/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 thefoldl/4's provided higher-order predicate lambda. The call toto_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, saypred(char, char) (as is the case forpromote/2), the underlying implementation *must* handle *all* values that a typechar could possibly hold. It is trivial to see that our code does not. This means that, in theory, it is possible thatpromote/2 (ordigit_to_roman/1) could be passed a value which cannot be processed, thus triggering a false result, and thus being semi-deterministic.
:- 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.$ '''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''
Another implementation using an algorithm inspired bythe 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 thedigit/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.
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]1990: MCMXC2008: MMVIII1666: MDCLXVI2023: MMXXIII
MODULERomanNumeralsEncode;FROMStringsIMPORTAppend;FROMSTextIOIMPORTWriteString,WriteLn;CONSTMaxChars=15;(* 3888 or MMMDCCCLXXXVIII (15 chars) is the longest string properly encoded with these symbols. *)TYPETRomanNumeral=ARRAY[0..MaxChars-1]OFCHAR;PROCEDUREToRoman(AValue:CARDINAL;VAROUTDestination:ARRAYOFCHAR);TYPETRomanSymbols=ARRAY[0..1]OFCHAR;TWeights=ARRAY[0..12]OFCARDINAL;TSymbols=ARRAY[0..12]OFTRomanSymbols;CONSTWeights=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"};VARI:CARDINAL;BEGINDestination:="";I:=0;WHILE(I<=HIGH(Weights))AND(AValue>0)DOWHILEAValue>=Weights[I]DOAppend(Symbols[I],Destination);AValue:=AValue-Weights[I]END;INC(I);END;ENDToRoman;VARNumeral:TRomanNumeral;BEGINToRoman(1990,Numeral);WriteString(Numeral);WriteLn;(* MCMXC *)ToRoman(2018,Numeral);WriteString(Numeral);WriteLn;(* MMXVIII *)ToRoman(3888,Numeral);WriteString(Numeral);WriteLn;(* MMMDCCCLXXXVIII *)ENDRomanNumeralsEncode.
MCMXCMMXVIIIMMMDCCCLXXXVIII
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
USER>W $$ROMAN^ROSETTA(1666)MDCLXVIUSER>W $$TOROMAN^ROSETTA(2010)MMXUSER>W $$TOROMAN^ROSETTA(949)CMXLIXUSER>W $$TOROMAN^ROSETTA(949.24)Invalid inputUSER>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 rimport strutilsconst 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 afor 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
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: CM1000: M1009: MIX1444: MCDXLIV1666: MDCLXVI1945: MCMXLV1997: MCMXCVII1999: MCMXCIX2000: MM2008: MMVIII2010: MMX2011: MMXI2500: MMD3000: MMM3999: MMMCMXCIX
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(); } }}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
# 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']
[ [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 ] ] ;
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 ) SKIPVIEW-AS ALERT-BOX.
---------------------------Message (Press HELP to view stack trace)---------------------------1990 MCMXC 2008 MMVIII 2000 MM 1666 MDCLXVI ---------------------------OK Help ---------------------------
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 endin {ForAll {Map [1999 25 944] ToRoman} System.showInfo}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()};See 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.1666 - MDCLXVI1945 - MCMXLV1997 - MCMXCVII1999 - MCMXCIX2000 - MM2008 - MMVIII2010 - MMX2011 - MMXI2500 - MMD3000 - MMM3999 - MMMCMXCIX
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</#></#>
Notice here the three different ways of representing the results.
For reasons for notational differences, seewp:Roman_numerals#Alternate_forms
1990 is ⅿⅽⅿⅹⅽ ⅯⅭⅯⅩⅭ MCMXC2008 is ⅿⅿⅷ ⅯⅯⅧ MMVIII1 is ⅰ Ⅰ I2 is ⅱ Ⅱ II64 is ⅼⅹⅳ ⅬⅩⅣ LXIV124 is ⅽⅹⅹⅳ ⅭⅩⅩⅣ CXXIV1666 is ⅿⅾⅽⅼⅹⅵ ⅯⅮⅭⅬⅩⅥ MDCLXVI10001 is ⅿⅿⅿⅿⅿⅿⅿⅿⅿⅿⅰ ↂⅠ MMMMMMMMMMI
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;use Math::Roman qw/roman/;say roman($_) for 1..2012'
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;with javascript_semanticsfunction 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){{1990,"MCMXC"},{2008,"MMVIII"},{1666,"MDCLXVI"}}with javascript_semanticsrequires("1.0.5")function toRoman(integer n) return {n,sprintf("%R",n)}end functionsame output (builtins\VM\pprntfN.e/toRoman() is somewhat more obfuscated and faster than the above)
include ..\Utilitys.pmtdef 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 resenddef1968 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 nlenddef1968 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 nlenddef1968 romanEnc
/** * 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;}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.455: CDLV 999: CMXCIX1990: MCMXC1999: MCMXCIX2000: MM2001: MMI2008: MMVIII2009: MMIX2010: MMX2011: MMXI2012: MMXII1666: MDCLXVI3456: MMMCDLVI3888: MMMDCCCLXXXVIII4000: MMMM
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.
[15 = 3888 = MMMDCCCLXXXVIII,14 = 3887 = MMMDCCCLXXXVII]
(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) ) ) ) )
: (roman 1009)-> "MIX": (roman 1666)-> "MDCLXVI"
import String;int main(){ write(int2roman(2009) + "\n"); write(int2roman(1666) + "\n"); write(int2roman(1337) + "\n");}/* 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
/***************************************************************** * $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 REPLACEFUNCTION rencode(an IN NUMBER) RETURN VARCHAR2 ISBEGIN 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')); -- MCMXCIXEND;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}\byeFilter ToRoman {$output = ''if ($_ -ge 4000) {throw 'Number too high'}$current = 1000$subtractor = 'M'$whole = $False$decimal = $_'C','D','X','L','I','V',' ' `| %{$divisor = $currentif ($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
XIXIVMMCDLXXIXMMMI
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]).?- roman.1789 in roman is MDCCLXXXIX2010 in roman is MMX110 in roman is CX1449 in roman is MCDXLIX1666 in roman is MDCLXVItrue .
import romanprint(roman.toRoman(2022))
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
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))
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 outif __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)))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 1def 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 2def 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, definingroman in terms ofmapAccumL:
'''Encoding Roman Numerals'''from functools import reducefrom itertools import chain# romanFromInt :: Int -> Stringdef 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] -> Stringdef 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) -> bdef snd(tpl): '''Second component of a tuple.''' return tpl[1]# MAIN ---if __name__ == '__main__': main()
MDCLXVIMCMXCMMVIIIMMXVIMMXVIIIMMXX
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
1990 = MCMXC2008 = MMVIII1666 = MDCLXVI
R has a built-in function,as.roman, for conversion to Roman numerals. The implementation details are found inutils:::.numeric2roman (see previous link), andutils:::.roman2numeric, for conversion back to Arabic decimals.
as.roman(1666) # MDCLXVI
Since the objectas.roman creates is just an integer vector with a class, you can do arithmetic with Roman numerals:
as.roman(1666) + 334 # MM
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)))
(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 usagefor 1 .. 2_010 -> $x { say roman($x);}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]]
$ENTRY Go { = <Show 1666> <Show 2008> <Show 1001> <Show 1999> <Show 3888> <Show 2025>; };Show { s.N = <Prout <Symb s.N> ' = ' <Roman s.N>>;};Roman { 0 = ; s.N, <RomanStep s.N>: s.Next e.Part = e.Part <Roman s.Next>;}; RomanStep { s.N = <RomanStep s.N <RomanDigits>>; s.N (s.Size e.Part) e.Parts, <Compare s.N <Sub s.Size 1>>: '+' = <Sub s.N s.Size> e.Part; s.N t.Part e.Parts = <RomanStep s.N e.Parts>;};RomanDigits { = (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');};1666 = MDCLXVI2008 = MMVIII1001 = MI1999 = MCMXCIX3888 = MMMDCCCLXXXVIII2025 = MMXXV
This is a port of theForth 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 ]&drop10 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 ;
roman: procedurearg 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) endendreturn result
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 forAttic,ancient Roman,
andmodern 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))))))))))))))))
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) + nlsee "1666 = " + toRoman(1666) + nlsee "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 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 rdigIF DUP 5000 <THEN "" SWAP 1 13FOR j divs j GET MOD LAST / IP ROT SWAPWHILE DUPREPEAT rdig j GET ROT SWAP + SWAP 1 -END DROP SWAPNEXTEND DROP ≫ '→ROM' STO | →ROM( n -- "ROMAN" )store tablesif n < 5000 then scan divisors x,y = divmod(n, divisor) if x > 0 then add related digit x times n = y clean stack |
| RPL code | Comment |
|---|---|
≪IF DUP 5000 <THEN { "IIIVIIIX" "XXXLXXXC" "CCCDCCCM" } { 11 21 31 43 44 54 64 74 87 88 } → rom args ≪ "" SWAP 1 3FOR j 10 MOD LAST / IPIF SWAPTHEN args LAST GET 10 MOD LAST / IP rom j GET ROT ROT SUB ROT + SWAPENDNEXT ≫WHILE DUPREPEAT 1 - "M" ROT + SWAPEND DROPEND ≫ '→ROM' STO | →ROM( n -- "M..CXVI" )collapsed Roman digits10 arguments to extract Roman digitsinitialize stackprocess units to hundreds divmod(n,10) if last digit ≠ 0 then get extraction arguments extract Roman digitadd thousands if anyclean stack |
Roman numeral generation was used as an example for demonstratingTest 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 endend[1990, 2008, 1666].each do |i| puts "%4d => %s" % [i, roman(i)]end1990 => MCMXC2008 => MMVIII1666 => 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 }endYet 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 endend
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); }}2014 = MMXIV1999 = MCMXCIX 25 = XXV1666 = MDCLXVI3888 = MMMDCCCLXXXVIII
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 => ""}scala> List(1990, 2008, 1666) map toRomanres55: List[String] = List(MCMXC, MMVIII, MDCLXVI)
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 testdef test( arabic:Int ) = println( arabic + " => " + toRoman( arabic ) ) test(1990)test(2008)test(1666)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) } }}1990 => MCMXC2008 => MMVIII1666 => MDCLXVI
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))))The following program writes the numbers between 1 and 3999 as roman numerals.Thewrinum.s7i library contains thefunctionstr(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].
function RomanNumeralsEncode numberput [(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 valuesrepeat for index = each item of (the number of items in values)..1put item index of values into pairrepeat while number is greater than or equal to the first item of pairput the second item of pair after numeralssubtract the first item of pair from numberend repeatend repeatreturn numeralsend RomanNumeralsEncode
repeat for each item in [1990,2008,1666]put RomanNumeralsEncode(it)end repeat
MCMXCMMVIIIMDCLXVI
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;
MMVIIIMDCLXVIMCMXC
(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]))
(4-) (encodeRoman 1990)"MCMXC"(5-) (encodeRoman 2008)"MMVIII"(6-) (encodeRoman 1666)"MDCLXVI"
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));1990 in roman is MCMXC2008 in roman is MMVIII1666 in roman is MDCLXVI
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;YEAR 1990 => MCMXCYEAR 2008 => MMVIIIYEAR 1666 => MDCLXVI
in ST/X, integers already know how to print themselves as roman number:
2013 printRomanOn:Stdout naive:false
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] ]. ].
Adapted fromCatspaw 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.ROMANN 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*TestingOUTPUT = "1999 = " ROMAN(1999)OUTPUT = " 24 = " ROMAN(24)OUTPUT = " 944 = " ROMAN(944)END1999 = 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 = astrend2010=MMX 1999=MCMXCIX 1492=MCDXCII 1066=MLXVI 476=CDLXXVIMMX=2010 MCMXCIX=1999 MCDXCII=1492 MLXVI=1066 CDLXXVI=476
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]))<
1990 = MCMXC2008 = MMVIII1666 = MDCLXVI
-- -- This only works under Oracle and has the limitation of 1 to 3999SQL> select to_char(1666, 'RN') urcoman, to_char(1666, 'rn') lcroman from dual;URCOMAN LCROMAN--------------- --------------- MDCLXVI mdclxvi
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
MDCLXVI
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 encodeRoman1990 -> encodeRoman -> !OUT::write'' -> !OUT::write2008 -> encodeRoman -> !OUT::write'' -> !OUT::write1666 -> encodeRoman -> !OUT::write
MCMXCMMVIIIMDCLXVI
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}$$ MODE TUSCRIPTLOOP arab_number="1990'2008'1666"roman_number = ENCODE (arab_number,ROMAN)PRINT "Arabic number ",arab_number, " equals ", roman_numberENDLOOP
Arabic number 1990 equals MCMXCArabic number 2008 equals MMVIIIArabic number 1666 equals MDCLXVI
Weights and symbols in tuples.
// Roman numerals/Encodeconst 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)); // MCMXCconsole.log(toRoman(2022)); // MMXXIIconsole.log(toRoman(3888)); // MMMDCCCLXXXVIIIMCMXCMMXXIIMMMDCCCLXXXVIII
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)done1999 = MCMXCIX24 = XXIV944 = CMXLIV1666 = MDCLXVI2008 = MMVIII
The algorithm is to implement thesubtractive principleby string substitution only after constucting the numeral from successiveremainders. The order among the substitutions matters. For example,occurrences of DCCCC must be replaced by CM before any occurrences ofCCCC are replaced by CD. The substitution operator (%=) is helpfulhere.
#import natroman = -+ '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>
MCMXCMMVIIIIIILXIVCXXIVMDCLXVIMMMMMMMMMMI
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));}CDLVMMMCDLVIMMCDLXXXVIII
Private Function roman(n As Integer) As String roman = WorksheetFunction.roman(n)End FunctionPublic Sub main() s = [{10, 2016, 800, 2769, 1666, 476, 1453}] For Each x In s Debug.Print roman(CInt(x)); " "; Next xEnd SubX MMXVI DCCC MMDCCLXIX MDCLXVI CDLXXVI MCDLIII
// 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)Return4 = IV 12 = XII 1666 = MDCLXVI 1990 = MCMXC 2011 = MMXI
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}MCMXCMMVIIIMDCLXVI
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))MCMXCMDCLXVIMMVIIIMMXX
Since the original solution was posted the above module has been written to support Roman numeral arithmetic. The original code can now be condensed as follows to produce exactly the same output as before.
import "./roman" for Romanfor (n in [1990, 1666, 2008, 2020]) System.print(Roman.new(n))
(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)))
(x mmxvi dccc mmdcclxix mdclxvi cdlxxvi mcdliii)
proc Rom(N, A, B, C); \Display 1..9 in Roman numeralsint N, A, B, C, I;[case N of9: [ChOut(0, C); ChOut(0, A)]; \XI8,7,6,5:[ChOut(0, B); for I:= 1 to rem(N/5) do ChOut(0, C)]; \V4: [ChOut(0, C); ChOut(0, B)] \IVother for I:= 1 to N do ChOut(0, C); \I];proc Roman(N); \Display N in Roman numeralsint N, Q;[Q:= N/1000; N:= rem(0); \0..3999Rom(Q, ^?, ^?, ^M);Q:= N/100; N:= rem(0); \0..999Rom(Q, ^M, ^D, ^C);Q:= N/10; N:= rem(0); \0..99Rom(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)];]
1990. MCMXC2008. MMVIII1666. MDCLXVI0. 1. I3999. MMMCMXCIX2020. MMXX1234. MCCXXXIV
<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>
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"
program: decimal_roman input: 12 output: 'XII'
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}