Roman numerals/Encode: Difference between revisions
m
→{{header|Phix}}: use pygments, added cheat version
(Dialects of BASIC moved to the BASIC section.) |
m (→{{header|Phix}}: use pygments, added cheat version) |
||
| (26 intermediate revisions by 14 users not shown) | |||
Line 31:
L(val) test
print(val‘ - ’to_roman(val))</syntaxhighlight>
=={{header|360 Assembly}}==
<syntaxhighlight lang="360asm">* Roman numerals Encode - 11/05/2020
ROMAENC CSECT
USING ROMAENC,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R6,1 i=1
DO WHILE=(C,R6,LE,=A(8)) do i=1 to hbound(nums)
LR R1,R6 i
SLA R1,1 ~
LH R8,NUMS-2(R1) n=nums(i)
MVC PG,=CL80'.... :' clear buffer
LA R9,PG @pg
XDECO R8,XDEC edit n
MVC 0(4,R9),XDEC+8 output n
LA R9,7(R9) @pg+=7
LA R7,1 j=1
DO WHILE=(C,R7,LE,=A(13)) do j=1 to 13
LR R1,R7 j
SLA R1,1 ~
LH R3,ARABIC-2(R1) aj=arabic(j)
DO WHILE=(CR,R8,GE,R3) while n>=aj
LR R1,R7 j
SLA R1,1 ~
LA R4,ROMAN-2(R1) roman(j)
MVC 0(2,R9),0(R4) output roman(j)
IF CLI,1(R9),NE,C' ' THEN if roman(j)[2]=' ' then
LA R9,2(R9) @pg+=2
ELSE , else
LA R9,1(R9) @pg+=1
ENDIF , endif
SR R8,R3 n-=aj
ENDDO , endwile
LA R7,1(R7) j++
ENDDO , enddo j
XPRNT PG,L'PG print buffer
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling save
ARABIC DC H'1000',H'900',H'500',H'400',H'100',H'90'
DC H'50',H'40',H'10',H'9',H'5',H'4',H'1'
ROMAN DC CL2'M',CL2'CM',CL2'D',CL2'CD',CL2'C',CL2'XC'
DC CL2'L',CL2'XL',CL2'X',CL2'IX',CL2'V',CL2'IV',CL2'I'
NUMS DC H'14',H'16',H'21',H'888',H'1492',H'1999',H'2020',H'3999'
PG DS CL80 buffer
XDEC DS CL12 temp for xdeco
REGEQU
END ROMAENC</syntaxhighlight>
{{out}}
<pre>
14 : XIV
16 : XVI
21 : XXI
888 : DCCCLXXXVIII
1492 : MCDXCII
1999 : MCMXCIX
2020 : MMXX
3999 : MMMCMXCIX
</pre>
=={{header|8080 Assembly}}==
Line 132 ⟶ 197:
dgtbuf: ds 6
romanbuf:</syntaxhighlight>
=={{header|8086 Assembly}}==
===Main and Supporting Functions===
Line 1,195 ⟶ 1,261:
3888 MMMDCCCLXXXVIII
</pre>
==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
{{trans|GW-BASIC}}
<syntaxhighlight lang="qbasic">100 cls
110 dim arabic(12), roman$(12)
120 for j = 0 to 12 : read arabic(j),roman$(j) : next j
130 data 1000,"M", 900,"CM", 500,"D", 400,"CD", 100,"C", 90,"XC"
140 data 50,"L",40,"XL",10,"X",9,"IX",5,"V",4,"IV",1,"I"
187 avalor = 1990 : print avalor "= "; : gosub 220 : print roman$ ' MCMXC
188 avalor = 2008 : print avalor "= "; : gosub 220 : print roman$ ' MMXXII
189 avalor = 1666 : print avalor "= "; : gosub 220 : print roman$ ' MDCLXVI
200 end
210 rem Encode to Roman
220 roman$ = "" : i = 0
230 while (i <= 12) and (avalor > 0)
240 while avalor >= arabic(i)
250 roman$ = roman$+roman$(i)
260 avalor = avalor-arabic(i)
270 wend
280 i = i+1
290 wend
300 return</syntaxhighlight>
{{out}}
<pre>1990 = MCMXC
2008 = MMVIII
1666 = MDCLXVI</pre>
==={{header|Commodore BASIC}}===
Line 1,421 ⟶ 1,514:
513 = DXIII
33 = XXXIII
</pre>
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">Public Sub Main()
'Testing
Print "2009 = "; toRoman(2009)
Print "1666 = "; toRoman(1666)
Print "3888 = "; toRoman(3888)
End
Function toRoman(value As Integer) As String
Dim result As String
Dim arabic As Integer[] = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
Dim roman As String[] = ["M", "CM", "D", "CD", "C", "XC", "L" , "XL", "X", "IX", "V", "IV", "I"]
For i As Integer = 0 To arabic.Max
Do While value >= arabic[i]
result &= roman[i]
value -= arabic[i]
Loop
Next
Return result
End Function</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
=== {{header|GW-BASIC}} ===
{{trans|DWScript}}
{{works with|BASICA}}
<syntaxhighlight lang="gwbasic">
10 REM Roman numerals/Encode
20 DIM WEIGHTS%(12), SYMBOLS$(12)
30 FOR J% = 0 TO 12: READ WEIGHTS%(J%), SYMBOLS$(J%): NEXT J%
40 DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"
50 DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"
60 REM 3888 or MMMDCCCLXXXVIII (15 chars) is
70 REM the longest string properly encoded
80 REM with these symbols.
90 AVALUE% = 1990: GOSUB 1000: PRINT ROMAN$ ' MCMXC
100 AVALUE% = 2022: GOSUB 1000: PRINT ROMAN$ ' MMXXII
110 AVALUE% = 3888: GOSUB 1000: PRINT ROMAN$ ' MMMDCCCLXXXVIII
120 END
990 REM Encode to roman
1000 ROMAN$ = "": I% = 0
1010 WHILE (I% <= 12) AND (AVALUE% > 0)
1020 WHILE AVALUE% >= WEIGHTS%(I%)
1030 ROMAN$ = ROMAN$ + SYMBOLS$(I%)
1040 AVALUE% = AVALUE% - WEIGHTS%(I%)
1050 WEND
1060 I% = I% + 1
1070 WEND
1080 RETURN
</syntaxhighlight>
{{out}}
<pre>
MCMXC
MMXXII
MMMDCCCLXXXVIII
</pre>
Line 2,972 ⟶ 3,129:
=={{header|EasyLang}}==
<syntaxhighlight lang="text">
func$ dec2rom dec .
values[] = [ 1000 900 500 400 100 90 50 40 10 9 5 4 1 ]
symbol$[] = [ "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX" "V" "IV" "I" ]
for i
while
rom$ &= symbol$[i]
.
.
return rom$
.
print
print dec2rom 1666
</syntaxhighlight>
=={{header|ECL}}==
Line 3,102 ⟶ 3,258:
=={{header|Elena}}==
{{trans|C#}}
ELENA
<syntaxhighlight lang="elena">import system'collections;
import system'routines;
Line 3,125 ⟶ 3,281:
extension op
{
}
Line 3,835 ⟶ 3,991:
ENDDO
END</syntaxhighlight>
=={{header|Hoon}}==
Library file (e.g. <code>/lib/rhonda.hoon</code>):
<syntaxhighlight lang="hoon">|%
++ parse
|= t=tape ^- @ud
=. t (cass t)
=| result=@ud
|-
?~ t result
?~ t.t (add result (from-numeral i.t))
=+ [a=(from-numeral i.t) b=(from-numeral i.t.t)]
?: (gte a b) $(result (add result a), t t.t)
$(result (sub (add result b) a), t t.t.t)
++ yield
|= n=@ud ^- tape
=| result=tape
=/ values to-numeral
|-
?~ values result
?: (gte n -.i.values)
$(result (weld result +.i.values), n (sub n -.i.values))
$(values t.values)
++ from-numeral
|= c=@t ^- @ud
?: =(c 'i') 1
?: =(c 'v') 5
?: =(c 'x') 10
?: =(c 'l') 50
?: =(c 'c') 100
?: =(c 'd') 500
?: =(c 'm') 1.000
!!
++ to-numeral
^- (list [@ud tape])
:*
[1.000 "m"]
[900 "cm"]
[500 "d"]
[400 "cd"]
[100 "c"]
[90 "xc"]
[50 "l"]
[40 "xl"]
[10 "x"]
[9 "ix"]
[5 "v"]
[4 "iv"]
[1 "i"]
~
==
--</syntaxhighlight>
Script file ("generator") (e.g. <code>/gen/roman.hoon</code>):
<syntaxhighlight lang="hoon">/+ *roman
:- %say
|= [* [x=$%([%from-roman tape] [%to-roman @ud]) ~] ~]
:- %noun
^- tape
?- -.x
%from-roman "{<(parse +.x)>}"
%to-roman (yield +.x)
==</syntaxhighlight>
=={{header|Icon}} and {{header|Unicon}}==
Line 4,935 ⟶ 5,157:
Its output is identical to that of the previous version.
=={{header|Miranda}}==
<syntaxhighlight lang="miranda">main :: [sys_message]
main = [ Stdout (show n ++ ": " ++ toroman n ++ "\n")
| n <- [1990, 2008, 1666, 2023]]
toroman :: num->[char]
toroman 0 = ""
toroman n = d ++ toroman (n - v)
where digits = [("M",1000),("CM",900),("D",500),("CD",400),
("C",100),("XC",90),("L",50),("XL",40),
("X",10),("IX",9),("V",5),("IV",4),
("I",1)]
(d, v) = hd [(d,v) | (d,v) <- digits; v <= n]</syntaxhighlight>
{{out}}
<pre>1990: MCMXC
2008: MMVIII
1666: MDCLXVI
2023: MMXXIII</pre>
=={{header|Modula-2}}==
Line 5,457 ⟶ 5,698:
=={{header|Phix}}==
<!--
<syntaxhighlight lang="phix">
with javascript_semantics
function toRoman(integer v)
sequence roman = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"},
decml = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }
string res = ""
integer val = v
for i=1 to length(roman) do
while val>=decml[i] do
res &= roman[i]
val -= decml[i]
end while
end for
return {v,res} -- (for output)
end function
?apply({1990,2008,1666},toRoman)
</syntaxhighlight>
{{out}}
<pre>
{{1990,"MCMXC"},{2008,"MMVIII"},{1666,"MDCLXVI"}}
</pre>
=== cheating slightly ===
<syntaxhighlight lang="phix">
with javascript_semantics
requires("1.0.5")
function toRoman(integer n)
return {n,sprintf("%R",n)}
end function
</syntaxhighlight>
same output (builtins\VM\pprntfN.e/toRoman() is somewhat more obfuscated and faster than the above)
=={{header|Phixmonti}}==
Line 5,926 ⟶ 6,177:
<syntaxhighlight lang="python">import roman
print(roman.toRoman(2022))</syntaxhighlight>
===Minimalistic structuralism===
<syntaxhighlight lang="python">def toRoman(n):
res='' #converts int to str(Roman numeral)
reg=n #using the numerals (M,D,C,L,X,V,I)
if reg<4000:#no more than three repetitions
while reg>=1000: #thousands up to MMM
res+='M' #MAX is MMMCMXCIX
reg-=1000
if reg>=900: #nine hundreds in 900-999
res+='CM'
reg-=900
if reg>=500: #five hudreds in 500-899
res+='D'
reg-=500
if reg>=400: #four hundreds in 400-499
res+='CD'
reg-=400
while reg>=100: #hundreds in 100-399
res+='C'
reg-=100
if reg>=90: #nine tens in 90-99
res+='XC'
reg-=90
if reg>=50: #five Tens in 50-89
res+='L'
reg-=50
if reg>=40:
res+='XL' #four Tens
reg-=40
while reg>=10:
res+="X" #tens
reg-=10
if reg>=9:
res+='IX' #nine Units
reg-=9
if reg>=5:
res+='V' #five Units
reg-=5
if reg>=4:
res+='IV' #four Units
reg-=4
while reg>0: #three or less Units
res+='I'
reg-=1
return res</syntaxhighlight>
===Imperative===
Line 6,046 ⟶ 6,343:
q, r = divmod(a, m)
return (r, s * q)
return concat(snd(mapAccumL(go)(n)(
zip([
Line 6,216 ⟶ 6,514:
Straight iterative solution:
<syntaxhighlight lang="red">
Red []
table: [1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I]
to-Roman: function [n [integer!] return: [string!]][
Line 6,228 ⟶ 6,528:
Straight recursive solution:
<syntaxhighlight lang="red">
Red []
table: [1000 M 900 CM 500 D 400 CD 100 C 90 XC 50 L 40 XL 10 X 9 IX 5 V 4 IV 1 I]
to-Roman: func [n [integer!] return: [string!]][
Line 6,243 ⟶ 6,545:
<syntaxhighlight lang="red">
Red []
to-Roman: function [n [integer!]] reduce [
'case collect [
Line 6,488 ⟶ 6,792:
return result
</syntaxhighlight>
=={{header|RPL}}==
{{trans|Python}}
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ { 1000 900 500 400 100 90 50 40 10 9 5 4 1 }
{ "M" "CM" "D" "CD" "C" "XC" "L" "XL" "X" "IX"
"V" "IV" "I" } → divs rdig
'''IF''' DUP 5000 < '''THEN'''
"" SWAP 1 13 '''FOR''' j
divs j GET MOD LAST / IP ROT SWAP
'''WHILE''' DUP '''REPEAT'''
rdig j GET ROT SWAP + SWAP 1 - '''END'''
DROP SWAP
'''NEXT'''
'''END''' DROP
≫ ''''→ROM'''' STO
|
'''→ROM''' ''( n -- "ROMAN" )''
store tables
if n < 5000 then
scan divisors
x,y = divmod(n, divisor)
if x > 0 then
add related digit x times
n = y
clean stack
|}
===Alternate version===
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ '''IF''' DUP 5000 < '''THEN'''
{ "IIIVIIIX" "XXXLXXXC" "CCCDCCCM" }
{ 11 21 31 43 44 54 64 74 87 88 } → rom args
≪ "" SWAP
1 3 '''FOR''' j
10 MOD LAST / IP
'''IF''' SWAP '''THEN'''
args LAST GET 10 MOD LAST / IP
rom j GET ROT ROT SUB ROT + SWAP '''END'''
'''NEXT''' ≫
'''WHILE''' DUP '''REPEAT''' 1 - "M" ROT + SWAP '''END'''
DROP '''END'''
≫ ''''→ROM'''' STO
|
'''→ROM''' ''( n -- "M..CXVI" ) ''
collapsed Roman digits
10 arguments to extract Roman digits
initialize stack
process units to hundreds
divmod(n,10)
if last digit ≠ 0 then
get extraction arguments
extract Roman digit
add thousands if any
clean stack
|}
=={{header|Ruby}}==
Line 7,100 ⟶ 7,473:
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
Line 7,106 ⟶ 7,479:
$ - $digits($@)::value -> #
when <1"1"..> do
@:$@ + 1
$ -> #
end encodeRoman
Line 7,338 ⟶ 7,711:
1990 = MCMXC
2011 = MMXI</pre>
=={{header|V (Vlang)}}==
<syntaxhighlight lang="Zig">
const numerals = {1000:"M", 900:"CM", 500:"D", 400:"CD", 100:"C",
90:"XC", 50:"L", 40: "XL", 10:"X", 9:"IX", 5:"V", 4:"IV", 1:"I"}
fn main() {
println(encode(1990))
println(encode(2008))
println(encode(1666))
}
fn encode(number int) string {
mut num := number
mut result := ""
if number < 1 || number > 5000 {return result}
for digit, roman in numerals {
for num >= digit {
num -= digit
result += roman
}
}
return result
}
</syntaxhighlight>
{{out}}
<pre>
MCMXC
MMVIII
MDCLXVI
</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="
[1000, "M"],
[900, "CM"],
Line 7,490 ⟶ 7,895:
</xsl:stylesheet>
</syntaxhighlight>
=={{header|zkl}}==
| |||