Roman numerals/Encode: Difference between revisions

==={{header|BaCon}}===

<syntaxhighlight lang="bacon">OPTION BASE 1

GLOBAL roman$[] = { "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I" }

GLOBAL number[] = { 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }

FUNCTION toroman$(value)

LOCAL result$

DOTIMES UBOUND(number)

WHILE value >= number[_]

result$ = result$ & roman$[_]

DECR value, number[_]

WEND

DONE

RETURN result$

ENDFUNC

PRINT toroman$(1990)

PRINT toroman$(2008)

PRINT toroman$(1666)

</syntaxhighlight>

{{out}}

<pre>

MCMXC

MMVIII

MDCLXVI

</pre>

==={{header|BASIC256}}===

{{works with|BASIC256 }}

<syntaxhighlight lang="basic256">

print 1666+" = "+convert$(1666)

print 2008+" = "+convert$(2008)

print 1001+" = "+convert$(1001)

print 1999+" = "+convert$(1999)

function convert$(value)

convert$=""

arabic = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1 }

roman$ = {"M", "CM", "D","CD", "C","XC","L","XL","X","IX","V","IV","I"}

for i = 0 to 12

while value >= arabic[i]

convert$ += roman$[i]

value = value - arabic[i]

end while

next i

end function

</syntaxhighlight>

{{out}}

<pre>

1666 = MDCLXVI

2008 = MMVIII

1001 = MI

1999 = MCMXCIX

</pre>

==={{header|BBC BASIC}}===

<syntaxhighlight lang="bbcbasic"> PRINT ;1999, FNroman(1999)

PRINT ;2012, FNroman(2012)

PRINT ;1666, FNroman(1666)

PRINT ;3888, FNroman(3888)

END

DEF FNroman(n%)

LOCAL i%, r$, arabic%(), roman$()

DIM arabic%(12), roman$(12)

arabic%() = 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900,1000

roman$() = "I","IV", "V","IX", "X","XL", "L","XC", "C","CD", "D","CM", "M"

FOR i% = 12 TO 0 STEP -1

WHILE n% >= arabic%(i%)

r$ += roman$(i%)

n% -= arabic%(i%)

ENDWHILE

NEXT

= r$</syntaxhighlight>

{{out}}

<pre>

1999 MCMXCIX

2012 MMXII

1666 MDCLXVI

3888 MMMDCCCLXXXVIII

</pre>

</pre>

Another solution:

<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64

Function romanEncode(n As Integer) As String

If n < 1 OrElse n > 3999 Then Return "" '' can only encode numbers in range 1 to 3999

Dim roman1(0 To 2) As String = {"MMM", "MM", "M"}

Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"}

Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"}

Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"}

Dim As Integer thousands, hundreds, tens, units

thousands = n \ 1000

n Mod= 1000

hundreds = n \ 100

n Mod= 100

tens = n \ 10

units = n Mod 10

Dim roman As String = ""

If thousands > 0 Then roman += roman1(3 - thousands)

If hundreds > 0 Then roman += roman2(9 - hundreds)

If tens > 0 Then roman += roman3(9 - tens)

If units > 0 Then roman += roman4(9 - units)

Return roman

End Function

Dim a(2) As Integer = {1990, 2008, 1666}

For i As Integer = 0 To 2

Print a(i); " => "; romanEncode(a(i))

Next

Print

Print "Press any key to quit"

Sleep</syntaxhighlight>

{{out}}

<pre>

1990 => MCMXC

2008 => MMVIII

1666 => MDCLXVI

</pre>

==={{header|FutureBasic}}===

<syntaxhighlight lang="futurebasic">window 1

local fn DecimaltoRoman( decimal as short ) as Str15

short arabic(12)

Str15 roman(12)

long i

Str15 result : result = ""

arabic(0) = 1000 : arabic(1) = 900 : arabic(2) = 500 : arabic(3) = 400

arabic(4) = 100 : arabic(5) = 90 : arabic(6) = 50 : arabic(7) = 40

arabic(8) = 10 : arabic(9) = 9 : arabic(10) = 5 : arabic(11) = 4: arabic(12) = 1

roman(0) = "M" : roman(1) = "CM" : roman(2) = "D" : roman(3) = "CD"

roman(4) = "C" : roman(5) = "XC" : roman(6) = "L" : roman(7) = "XL"

roman(8) = "X" : roman(9) = "IX" : roman(10) = "V" : roman(11) = "IV" : roman(12) = "I"

for i = 0 to 12

while ( decimal >= arabic(i) )

result = result + roman(i)

decimal = decimal - arabic(i)

wend

next i

if result == "" then result = "Zepherium"

end fn = result

print "1990 = "; fn DecimaltoRoman( 1990 )

print "2008 = "; fn DecimaltoRoman( 2008 )

print "2016 = "; fn DecimaltoRoman( 2016 )

print "1666 = "; fn DecimaltoRoman( 1666 )

print "3888 = "; fn DecimaltoRoman( 3888 )

print "1914 = "; fn DecimaltoRoman( 1914 )

print "1000 = "; fn DecimaltoRoman( 1000 )

print " 513 = "; fn DecimaltoRoman( 513 )

print " 33 = "; fn DecimaltoRoman( 33 )

HandleEvents</syntaxhighlight>

Output:

<pre>

1990 = MCMXC

2008 = MMVIII

2016 = MMXVI

1666 = MDCLXVI

3888 = MMMDCCCLXXXVIII

1914 = MCMXIV

1000 = M

513 = DXIII

33 = XXXIII

==={{header|Liberty BASIC}}===

{{works with|Just BASIC}}

<syntaxhighlight lang="lb">

dim arabic( 12)

for i =0 to 12

read k

arabic( i) =k

next i

data 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1

dim roman$( 12)

for i =0 to 12

read k$

roman$( i) =k$

next i

data "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"

print 2009, toRoman$( 2009)

print 1666, toRoman$( 1666)

print 3888, toRoman$( 3888)

end

function toRoman$( value)

i =0

result$ =""

for i = 0 to 12

while value >=arabic( i)

result$ = result$ + roman$( i)

value = value - arabic( i)

wend

next i

toRoman$ =result$

end function

</syntaxhighlight>

<pre>

2009 MMIX

1666 MDCLXVI

3888 MMMDCCCLXXXVIII

</pre>

==={{header|Microsoft Small Basic}}===

{{trans|DWScript}}

<syntaxhighlight lang="microsoftsmallbasic">

arabicNumeral = 1990

ConvertToRoman()

TextWindow.WriteLine(romanNumeral) 'MCMXC

arabicNumeral = 2018

ConvertToRoman()

TextWindow.WriteLine(romanNumeral) 'MMXVIII

arabicNumeral = 3888

ConvertToRoman()

TextWindow.WriteLine(romanNumeral) 'MMMDCCCLXXXVIII

Sub ConvertToRoman

weights[0] = 1000

weights[1] = 900

weights[2] = 500

weights[3] = 400

weights[4] = 100

weights[5] = 90

weights[6] = 50

weights[7] = 40

weights[8] = 10

weights[9] = 9

weights[10] = 5

weights[11] = 4

weights[12] = 1

symbols[0] = "M"

symbols[1] = "CM"

symbols[2] = "D"

symbols[3] = "CD"

symbols[4] = "C"

symbols[5] = "XC"

symbols[6] = "L"

symbols[7] = "XL"

symbols[8] = "X"

symbols[9] = "IX"

symbols[10] = "V"

symbols[11] = "IV"

symbols[12] = "I"

romanNumeral = ""

i = 0

While (i <= 12) And (arabicNumeral > 0)

While arabicNumeral >= weights[i]

romanNumeral = Text.Append(romanNumeral, symbols[i])

arabicNumeral = arabicNumeral - weights[i]

EndWhile

i = i + 1

EndWhile

EndSub

</syntaxhighlight>

{{out}}

<pre>

MCMXC

MMXVIII

MMMDCCCLXXXVIII

</pre>

==={{header|PowerBASIC}}===

{{trans|BASIC}}

{{works with|PB/Win|8+}}

{{works with|PB/CC|5}}

<syntaxhighlight lang="powerbasic">FUNCTION toRoman(value AS INTEGER) AS STRING

DIM arabic(0 TO 12) AS INTEGER

DIM roman(0 TO 12) AS STRING

ARRAY ASSIGN arabic() = 1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1

ARRAY ASSIGN roman() = "M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"

DIM i AS INTEGER

DIM result AS STRING

FOR i = 0 TO 12

DO WHILE value >= arabic(i)

result = result & roman(i)

value = value - arabic(i)

LOOP

NEXT i

toRoman = result

END FUNCTION

FUNCTION PBMAIN

'Testing

? "2009 = " & toRoman(2009)

? "1666 = " & toRoman(1666)

? "3888 = " & toRoman(3888)

END FUNCTION</syntaxhighlight>

==={{header|PureBasic}}===

<syntaxhighlight lang="purebasic">#SymbolCount = 12 ;0 based count

DataSection

denominations:

Data.s "M","CM","D","CD","C","XC","L","XL","X","IX","V","IV","I" ;0-12

denomValues:

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

EndDataSection

;-setup

Structure romanNumeral

symbol.s

value.i

EndStructure

Global Dim refRomanNum.romanNumeral(#SymbolCount)

Restore denominations

For i = 0 To #SymbolCount

Read.s refRomanNum(i)\symbol

Next

Restore denomValues

For i = 0 To #SymbolCount

Read refRomanNum(i)\value

Next

Procedure.s decRoman(n)

;converts a decimal number to a roman numeral

Protected roman$, i

For i = 0 To #SymbolCount

Repeat

If n >= refRomanNum(i)\value

roman$ + refRomanNum(i)\symbol

n - refRomanNum(i)\value

Else

Break

EndIf

ForEver

Next

ProcedureReturn roman$

EndProcedure

If OpenConsole()

PrintN(decRoman(1999)) ;MCMXCIX

PrintN(decRoman(1666)) ;MDCLXVI

PrintN(decRoman(25)) ;XXV

PrintN(decRoman(954)) ;CMLIV

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")

Input()

CloseConsole()

EndIf</syntaxhighlight>

==={{header|QBasic}}===

<syntaxhighlight lang="qbasic">DIM SHARED arabic(0 TO 12)

DIM SHARED roman$(0 TO 12)

FUNCTION toRoman$ (value)

LET result$ = ""

FOR i = 0 TO 12

DO WHILE value >= arabic(i)

LET result$ = result$ + roman$(i)

LET value = value - arabic(i)

LOOP

NEXT i

toRoman$ = result$

END FUNCTION

FOR i = 0 TO 12

READ arabic(i), roman$(i)

NEXT i

DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"

DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"

'Testing

PRINT "2009 = "; toRoman$(2009)

PRINT "1666 = "; toRoman$(1666)

PRINT "3888 = "; toRoman$(3888)</syntaxhighlight>

==={{header|Run BASIC}}===

<syntaxhighlight lang="runbasic">[loop]

input "Input value:";val$

print roman$(val$)

goto [loop]

' ------------------------------

' Roman numerals

' ------------------------------

FUNCTION roman$(val$)

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

v = val(val$)

for i = 1 to 13

r$ = word$(a2r$,i,",")

a = val(word$(r$,2,":"))

while v >= a

roman$ = roman$ + word$(r$,1,":")

v = v - a

wend

next i

END FUNCTION</syntaxhighlight>

==={{header|TI-83 BASIC}}===

<syntaxhighlight lang="ti83b">PROGRAM:DEC2ROM

:"="→Str1

:Lbl ST

:ClrHome

:Disp "NUMBER TO"

:Disp "CONVERT:"

:Input A

:If fPart(A) or A≠abs(A)

:Then

:Goto PI

:End

:A→B

:While B≥1000

:Str1+"M"→Str1

:B-1000→B

:End

:If B≥900

:Then

:Str1+"CM"→Str1

:B-900→B

:End

:If B≥500

:Then

:Str1+"D"→Str1

:B-500→B

:End

:If B≥400

:Then

:Str1+"CD"?Str1

:B-400→B

:End

:While B≥100

:Str1+"C"→Str1

:B-100→B

:End

:If B≥90

:Then

:Str1+"XC"→Str1

:B-90→B

:End

:If B≥50

:Then

:Str1+"L"→Str1

:B-50→B

:End

:If B≥40

:Then

:Str1+"XL"→Str1

:B-40→B

:End

:While B≥10

:Str1+"X"→Str1

:B-10→B

:End

:If B≥9

:Then

:Str1+"IX"→Str1

:B-9→B

:End

:If B≥5

:Then

:Str1+"V"→Str1

:B-5→B

:End

:If B≥4

:Then

:Str1+"IV"→Str1

:B-4→B

:End

:While B>0

:Str1+"I"→Str1

:B-1→B

:End

:ClrHome

:Disp A

:Disp Str1

:Stop

:Lbl PI

:ClrHome

:Disp "THE NUMBER MUST"

:Disp "BE A POSITIVE"

:Disp "INTEGER."

:Pause

:Goto ST

</syntaxhighlight>

==={{header|True BASIC}}===

<syntaxhighlight lang="qbasic">OPTION BASE 0

DIM arabic(12), roman$(12)

FOR i = 0 to 12

READ arabic(i), roman$(i)

NEXT i

DATA 1000, "M", 900, "CM", 500, "D", 400, "CD", 100, "C", 90, "XC"

DATA 50, "L", 40, "XL", 10, "X", 9, "IX", 5, "V", 4, "IV", 1, "I"

FUNCTION toRoman$(value)

LET result$ = ""

FOR i = 0 TO 12

DO WHILE value >= arabic(i)

LET result$ = result$ & roman$(i)

LET value = value - arabic(i)

LOOP

NEXT i

LET toRoman$ = result$

END FUNCTION

!Testing

PRINT "2009 = "; toRoman$(2009)

PRINT "1666 = "; toRoman$(1666)

PRINT "3888 = "; toRoman$(3888)

END</syntaxhighlight>

==={{header|uBasic/4tH}}===

{{trans|BBC Basic}}

<syntaxhighlight lang="text">Push 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000

' Initialize array

For i = 12 To 0 Step -1

@(i) = Pop()

Next

' Calculate and print numbers

Print 1999, : Proc _FNroman (1999)

Print 2014, : Proc _FNroman (2014)

Print 1666, : Proc _FNroman (1666)

Print 3888, : Proc _FNroman (3888)

End

_FNroman Param (1) ' ( n --)

Local (1) ' Define b@

' Try all numbers in array

For b@ = 12 To 0 Step -1

Do While a@ > @(b@) - 1 ' Several occurences of same number?

GoSub ((b@ + 1) * 10) ' Print roman digit

a@ = a@ - @(b@) ' Decrement number

Loop

Next

Print ' Terminate line

Return

' Print roman digits

10 Print "I"; : Return

20 Print "IV"; : Return

30 Print "V"; : Return

40 Print "IX"; : Return

50 Print "X"; : Return

60 Print "XL"; : Return

70 Print "L"; : Return

80 Print "XC"; : Return

90 Print "C"; : Return

100 Print "CD"; : Return

110 Print "D"; : Return

120 Print "CM"; : Return

130 Print "M"; : Return</syntaxhighlight>

==={{header|Visual Basic}}===

{{trans|BASIC}}

<syntaxhighlight lang="vb">Function toRoman(value) As String

Dim arabic As Variant

Dim roman As Variant

arabic = Array(1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1)

roman = Array("M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I")

Dim i As Integer, result As String

For i = 0 To 12

Do While value >= arabic(i)

result = result + roman(i)

value = value - arabic(i)

Loop

Next i

toRoman = result

End Function

Sub Main()

MsgBox toRoman(Val(InputBox("Number, please")))

End Sub</syntaxhighlight>

==={{header|XBasic}}===

{{trans|DWScript}}

{{works with|Windows XBasic}}

<syntaxhighlight lang="xbasic">

PROGRAM "romanenc"

VERSION "0.0000"

DECLARE FUNCTION Entry()

INTERNAL FUNCTION ToRoman$(aValue%%)

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

FUNCTION Entry()

PRINT ToRoman$(1990) ' MCMXC

PRINT ToRoman$(2018) ' MMXVIII

PRINT ToRoman$(3888) ' MMMDCCCLXXXVIII

END FUNCTION

FUNCTION ToRoman$(aValue%%)

DIM weights%%[12]

DIM symbols$[12]

weights%%[0] = 1000

weights%%[1] = 900

weights%%[2] = 500

weights%%[3] = 400

weights%%[4] = 100

weights%%[5] = 90

weights%%[6] = 50

weights%%[7] = 40

weights%%[8] = 10

weights%%[9] = 9

weights%%[10] = 5

weights%%[11] = 4

weights%%[12] = 1

symbols$[0] = "M"

symbols$[1] = "CM"

symbols$[2] = "D"

symbols$[3] = "CD"

symbols$[4] = "C"

symbols$[5] = "XC"

symbols$[6] = "L"

symbols$[7] = "XL"

symbols$[8] = "X"

symbols$[9] = "IX"

symbols$[10] = "V"

symbols$[11] = "IV"

symbols$[12] = "I"

destination$ = ""

i@@ = 0

DO WHILE (i@@ <= 12) AND (aValue%% > 0)

DO WHILE aValue%% >= weights%%[i@@]

destination$ = destination$ + symbols$[i@@]

aValue%% = aValue%% - weights%%[i@@]

LOOP

i@@ = i@@ + 1

LOOP

RETURN destination$

END FUNCTION

END PROGRAM

</syntaxhighlight>

{{out}}

<pre>

MCMXC

MMXVIII

MMMDCCCLXXXVIII

</pre>

==={{header|Yabasic}}===

<syntaxhighlight lang="yabasic">roman$ = "M, CM, D, CD, C, XC, L, XL, X, IX, V, IV, I"

decml$ = "1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1"

sub toRoman$(value)

local res$, i, roman$(1), decml$(1), long

long = token(roman$, roman$(), ", ")

long = token(decml$, decml$(), ", ")

for i=1 to long

while(value >= val(decml$(i)))

res$ = res$ + roman$(i)

value = value - val(decml$(i))

wend

next i

return res$

end sub

print 400, " ", toRoman$(400)

print 1990, " ", toRoman$(1990)

print 2008, " ", toRoman$(2008)

print 2009, " ", toRoman$(2009)

print 1666, " ", toRoman$(1666)

print 3888, " ", toRoman$(3888)

//Output:

// 400 = CD

// 1990 = MCMXC

// 2008 = MMVIII

// 2009 = MMIX

// 1666 = MDCLXVI

// 3888 = MMMDCCCLXXXVIII</syntaxhighlight>