Author Topic: Decimal to roman numbers converter (Read 10135 times)

Richard Frost · « **Reply #15 on:** August 30, 2020, 02:27:18 am »

A single page table of Roman numerals for decoding movie copyrite years.

Code: QB64: [Select]

DEFINT A-Z
DIM er$(30), ev(30)
CLS
FOR i = 1 TO 29
    READ ev(i), er$(i)
NEXT i
r = 1: c = 1
FOR d = 1920 TO 2039
    d$ = LTRIM$(STR$(d))
    t$ = ""
    FOR i = 1 TO LEN(d$)
        c$ = MID$(d$, i, 1)
        t = VAL(c$) * (10 ^ (LEN(d$) - i))
        FOR j = 1 TO 29
            IF ev(j) = t THEN t$ = t$ + er$(j)
        NEXT j
    NEXT i
    LOCATE r, c: PRINT d$; " "; t$;
    r = r + 1
    IF r > 24 THEN
        r = 1
        c = c + 16
    END IF
NEXT d
SLEEP
SYSTEM
 
table:
DATA 1,I
DATA 2,II
DATA 3,III
DATA 4,IV
DATA 5,V
DATA 6,VI
DATA 7,VII
DATA 8,IIX
DATA 9,IX
DATA 10,X
DATA 20,XX
DATA 30,XXX
DATA 40,XL
DATA 50,L
DATA 60,LX
DATA 70,LXX
DATA 80,XXC
DATA 90,XC
DATA 100,C
DATA 200,CC
DATA 300,CCC
DATA 400,CD
DATA 500,D
DATA 600,DC
DATA 700,DCC
DATA 800,CCM
DATA 900,CM
DATA 1000,M
DATA 2000,MM
 

SMcNeill · « **Reply #16 on:** August 30, 2020, 03:36:40 am »

Here's my little go at this conversion process:

Code: QB64: [Select]

DIM Symbols(1 TO 3) AS STRING, Values(0 TO 3999) AS STRING
Symbols(1) = "IXCM" 'Symbols is a string array to hold the symbols of our roman numerals
Symbols(2) = "VLD "
Symbols(3) = "XCM "
 
FOR I = 0 TO 3999 'here, we build our roman numerals from 0 to 3999 and store them in an array.
    t$ = _TRIM$(STR$(I))
    FOR k = 1 TO LEN(t$)
        t = ASC(t$, k) - 48: j = LEN(t$) - k + 1
        d$ = ""
        SELECT EVERYCASE t
            CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 3: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 4 TO 8: d$ = d$ + MID$(Symbols(2), j, 1)
            CASE 6 TO 9: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 7 TO 8: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 8: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 9: d$ = d$ + MID$(Symbols(3), j, 1)
        END SELECT
        Values(I) = Values(I) + d$
    NEXT
NEXT
 
l = 1: PRINT " = ";
DO 'here we use a custom input routine to get the users value and show its conversion
    t$ = INPUT$(1)
    SELECT CASE t$
        CASE "0" TO "9": v$ = v$ + t$
        CASE CHR$(27): SYSTEM
        CASE CHR$(8): v$ = LEFT$(v$, LEN(v$) - 1)
        CASE CHR$(13): l = l + 1: v$ = "": IF l > _HEIGHT - 1 THEN PRINT: l = _HEIGHT - 1
    END SELECT
    LOCATE l, 1: PRINT "                                           ";
    LOCATE l, 1: PRINT v$; " = ";
    v = VAL(v$)
    IF v < 4000 THEN
        PRINT Values(v);
    ELSE
        PRINT "Invalid value for this program.";
    END IF
    _DISPLAY
LOOP
 

This has your custom input routine that you were wanting, so you can use ESC at any time to quit, as well as on-the-fly conversion and array storage of our values. What I'm doing here is simply building an array with all the values from 0 to 3999, and then creating all the roman numerals and putting them in the array, for ease of future reference. If you want to know what the roman numeral value is for 123, all you need to do is PRINT Values(123).

For a reverse conversion routine, all one would have to do is allow the user to input symbols (IVXCLDM), and then when the value is 0, check to see if the entered string matches any of the valid roman numerals we built. If so, then print the matching value, else print the error message.. I didn't bother to add the reverse conversion, as it's getting to be this old man's bedtime, but if someone wants it, and doesn't want to add it themselves, just toss me a message and I'll add in the functionality tomorrow. ;)

bplus · « **Reply #17 on:** August 30, 2020, 12:15:21 pm »

Well Steve has suggested a clever way of checking proper Roman Numeral Numbers and doing the decimal conversions is interesting as well. I have never seen SELECT EVERYCASE before!

I was wondering how the following would work then I saw EVERYCASE:

Code: QB64: [Select]

            CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)

Here is what I have from last night, wasted in checking RomanProper$ function, ha!

Code: QB64: [Select]

_TITLE "Roman2Decimal Test, enter nothing will quit test loop, there are 3 test loops." ' B+ 2020-08-29
' 2020-08-29 how to go the other way? Decimal2Roman$
' RomanProper$ confirms a proper Roman Numeral with Y for Yes else error message.
 
DO
    PRINT "                 *** Testing the RomanProper$ function ***"
    PRINT "    Please enter a funky Roman Numeral to see if we can catch what is wrong,"
    PRINT "        or enter a good one and see if we can catch it being right :)"
    PRINT
    INPUT " Enter test: "; test$
    IF test$ = "" THEN EXIT DO
    returned$ = RomanProper$(test$)
    IF returned$ = "Y" THEN
        PRINT "        The RomanProper$ function detected no erors for "; test$
    ELSE
        PRINT SPACE$(5) + returned$
    END IF
    PRINT
LOOP
 
DO
    PRINT "       *** Testing the Decimal2Roman$ function ***"
    INPUT " Enter a number (1 to 3999) to convert to Roman Numerals "; test
    IF test = 0 THEN EXIT DO
    convert$ = Decimal2Roman$(test)
    PRINT "The converter says that should be: "; convert$
    PRINT
LOOP
 
DO
    PRINT "            *** Testing the Roman2Decimal% function ***"
    PRINT " Enter a number (1 to 3999) in Roman Numerals to test proper conversion: "
    PRINT
    INPUT " Enter test string "; test$
    IF test$ = "" THEN EXIT DO
    convert = Roman2Decimal%(test$)
    PRINT "The converter says that was: "; convert
    PRINT
LOOP
 
FUNCTION Roman2Decimal% (rS$) 'Caution: no checks for Roman syntax
    STATIC Roman$, rV(1 TO 7) AS INTEGER
    IF rV(7) <> 1000 THEN 'do once and for all time
        Roman$ = "IVXLCDM"
        FOR i = 1 TO 7
            IF i MOD 2 = 0 THEN rV(i) = 5 * 10 ^ (i / 2 - 1) ELSE rV(i) = 10 ^ ((i - 1) / 2)
        NEXT
    END IF
    'now for the current call
    FOR i = 1 TO LEN(rS$)
        lv = rV(INSTR(Roman$, MID$(rS$, i, 1)))
        IF i <> LEN(rS$) THEN
            lv2 = rV(INSTR(Roman$, MID$(rS$, i + 1, 1)))
            IF lv2 > lv THEN lv = -lv
        END IF
        convert = convert + lv
    NEXT
    Roman2Decimal% = convert
END FUNCTION
 
FUNCTION Decimal2Roman$ (d AS INTEGER) ' 1 to 3999
    cd = d 'make copy because changing
    STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10)
    IF Ones$(10) = "" THEN 'setup our arrays
        Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
        Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
        FOR i = 1 TO 10
            Tens$(i) = strReplace$(Ones$(i), "X", "C")
            Tens$(i) = strReplace$(Tens$(i), "I", "X")
            Tens$(i) = strReplace$(Tens$(i), "V", "L")
            H100s$(i) = strReplace$(Ones$(i), "X", "M")
            H100s$(i) = strReplace$(H100s$(i), "I", "C")
            H100s$(i) = strReplace$(H100s$(i), "V", "D")
        NEXT
    END IF
    IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M"): cd = cd - 1000 * INT(cd / 1000)
    IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100)): cd = cd - 100 * INT(cd / 100)
    IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10)): cd = cd - 10 * INT(cd / 10)
    IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
    Decimal2Roman$ = convert$
END FUNCTION
 
FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive  2020-07-28 version
    DIM p AS LONG, sCopy$, LR AS INTEGER, lNew AS INTEGER
    IF LEN(s$) = 0 OR LEN(replace$) = 0 THEN
        strReplace$ = s$: EXIT FUNCTION
    ELSE
        LR = LEN(replace$): lNew = LEN(new$)
    END IF
 
    sCopy$ = s$ ' otherwise s$ would get changed
    p = INSTR(sCopy$, replace$)
    WHILE p
        sCopy$ = MID$(sCopy$, 1, p - 1) + new$ + MID$(sCopy$, p + LR)
        p = INSTR(p + lNew, sCopy$, replace$)
    WEND
    strReplace$ = sCopy$
END FUNCTION
 
FUNCTION RomanProper$ (test$) ' is test$ a Roman Numeral with proper syntax? Y for Yes, if No then error message.
    test$ = _TRIM$(UCASE$(test$)) ' it should be OK to make this change to the argument in not in Capitals
    Roman$ = "MDCLXVI": checked$ = SPACE$(7) ' 2, 4, 6 should only appear once the others up to 3 except M 4 max
    FOR i = 1 TO LEN(test$)
        L$ = MID$(test$, i, 1)
        p = INSTR(Roman$, L$)
        IF i <> LEN(test$) THEN nextL$ = MID$(test$, i + 1, 1) ELSE nextL$ = ""
 
        IF p = 0 THEN RomanProper$ = "Error: wrong character in string.": EXIT SUB
        IF p MOD 2 = 0 THEN
            IF L$ = "V" THEN
                IF nextL$ <> "" AND nextL$ <> "I" THEN RomanProper$ = "Error: out of order.": EXIT SUB
            ELSEIF L$ = "L" THEN
                IF nextL$ <> "" AND nextL$ <> "I" AND nextL$ <> "V" AND nextL$ <> "X" THEN RomanProper$ = "Error: out of order.": EXIT SUB
                IF lastL$ = "I" THEN RomanProper$ = "Error: out of order.": EXIT SUB
            ELSEIF L$ = "D" THEN
                IF nextL$ = "M" THEN RomanProper$ = "Error: out of order.": EXIT SUB
                IF lastp > p AND lastL$ <> "C" THEN RomanProper$ = "Error: out of order.": EXIT SUB
            END IF
            IF MID$(checked$, p, 1) = " " THEN
                MID$(checked$, p, 1) = "1"
            ELSE
                RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
            END IF
        ELSE ' p mod 2 = 1
            vM = VAL(MID$(checked$, p, 1))
            IF L$ = "M" THEN
                IF (lastL$ <> "M" AND lastL$ <> "C") AND lastL$ <> "" THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
                IF vM > 3 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
                MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
            ELSEIF L$ = "C" THEN
                IF lastL$ = "L" OR lastL$ = "V" OR lastL$ = "I" THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
                IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
                MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
            ELSEIF L$ = "X" THEN
                IF MID$(checked$, 6, 1) = "1" OR VAL(MID$(checked$, 7, 1)) > 1 THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
                IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
                MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
            ELSEIF L$ = "I" THEN 'can follow any letter
                IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
                MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
            END IF
        END IF
        lastp = p
        lastL$ = L$
    NEXT
    'still here?
    RomanProper$ = "Y" 'then must be OK
END FUNCTION
 
 
 

Just to see, I will rewrite this with Steve's idea for check of RomanProper$ and a more straightforward way for decimal2Roman$.

SMcNeill · « **Reply #18 on:** August 30, 2020, 01:00:02 pm »

Quote

I was wondering how the following would work the I saw EVERYCASE:
CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)

My idea was this one:

Each 10's digit is basically made up of 3 symbols.

Numbers 1-10 use I, V, X
Numbers 10 - 100 use X, L, C
Numbers 100 - 1000 use C, D, M

The pattern we generate is always the same:
1 = 1st symbol
2 = double 1st symbol
3 = triple 1st symbol
4 = 1st symbol + 2nd symbol
And so on...

So 3 is III. 30 is XXX. 300 is CCC... Same logic pattern, just different symbols based on the 10's position. That's where the DIM Symbols(1 TO 3) array comes from, and represents.

The SELECT EVERY CASE just builds our symbols, to match our values.
CASE 1 TO 4 -- This says we need the first symbol that matches our 10s position, if our number is from 1 to 4.
CASE 2 TO 3 -- does the same, if our number is a 2 or a 3.
CASE 3 -- same, but only if the value is 3.

So if my number is 2, the first case is valid, the second case is valid, but the third case isn't... We build the number II, XX, CC, depending on our 10's position.

So for 22, we just build our value with the XX and then the II, making the answer XXII.

Basically, the SELECT EVERYCASE can be considered to be nothing more than a row of IF statements, all with the same comparison value. The above could also be written as:

IF X >= 1 AND X <= 4 THEN... Do stuff
IF X >= 2 AND X <= 3 THEN... Do stuff
IF X = 3 THEN... Do stuff

bplus · « **Reply #19 on:** August 30, 2020, 01:12:28 pm »

@SMcNeill That's very cool pattern recognition!

And what a great demo of EVERYCASE!

SMcNeill · « **Reply #20 on:** August 30, 2020, 01:27:15 pm »

And here's the same routine, working in converting in both directions, as far as I can tell.

Code: QB64: [Select]

DIM Symbols(1 TO 3) AS STRING, Values(0 TO 3999) AS STRING
Symbols(1) = "IXCM" 'Symbols is a string array to hold the symbols of our roman numerals
Symbols(2) = "VLD "
Symbols(3) = "XCM "
 
FOR I = 0 TO 3999 'here, we build our roman numerals from 0 to 3999 and store them in an array.
    t$ = _TRIM$(STR$(I))
    FOR k = 1 TO LEN(t$)
        t = ASC(t$, k) - 48: j = LEN(t$) - k + 1
        d$ = ""
        SELECT EVERYCASE t
            CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 3: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 4 TO 8: d$ = d$ + MID$(Symbols(2), j, 1)
            CASE 6 TO 9: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 7 TO 8: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 8: d$ = d$ + MID$(Symbols(1), j, 1)
            CASE 9: d$ = d$ + MID$(Symbols(3), j, 1)
        END SELECT
        Values(I) = Values(I) + d$
    NEXT
NEXT
 
l = 1: PRINT " = ";
DO 'here we use a custom input routine to get the users value and show its conversion
    t$ = INPUT$(1)
    SELECT CASE UCASE$(t$)
        CASE "0" TO "9", "I", "X", "V", "C", "D", "L", "M": v$ = v$ + UCASE$(t$)
        CASE CHR$(27): SYSTEM
        CASE CHR$(8): v$ = LEFT$(v$, LEN(v$) - 1)
        CASE CHR$(13): l = l + 1: v$ = "": IF l > _HEIGHT - 1 THEN PRINT: l = _HEIGHT - 1
    END SELECT
    LOCATE l, 1: PRINT "                                           ";
    LOCATE l, 1: PRINT v$; " = ";
    v = VAL(v$)
    IF v = 0 THEN
        FOR I = 0 TO 3999
            IF v$ = Values(I) THEN PRINT I;: EXIT FOR
        NEXT
        IF I = 4000 THEN PRINT "Invalid value for this program.";
    ELSEIF v < 4000 THEN
        PRINT Values(v);
    ELSE
        PRINT "Invalid value for this program.";
    END IF
    _DISPLAY
LOOP
 

For less than 50 lines of code, I think it's about as simple as one can get for a decimal-to-roman-to-decimal conversion program. ;)

bplus · « **Reply #21 on:** August 30, 2020, 03:15:17 pm »

And here is handy 40 line SUB you can plug into any program and use to translate, to or from, Roman Numerals 1 to 3999 along with error messages if it can't do a translation.

Code: QB64: [Select]

_TITLE "Roman SUB Test" ' B+ 2020-08-30 rewrite old to one sub, using several hints from SMcNeill
DO
    PRINT " Testing conversion of numbers 1 to 3999 to or from Roman Numerals >"
    INPUT " Enter a string to test "; test$
    Roman test$, return$
    PRINT " The Roman SUB returned: "; return$
    PRINT
LOOP UNTIL test$ = ""
 
SUB Roman (inStr$, outStr$) ' 1 to 3999
    STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10), R$(1 TO 3999)
    IF Ones$(10) = "" THEN 'setup our arrays
        Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
        Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
        Tens$(1) = "X": Tens$(2) = "XX": Tens$(3) = "XXX": Tens$(4) = "XL": Tens$(5) = "L"
        Tens$(6) = "LX": Tens$(7) = "LXX": Tens$(8) = "LXXX": Tens$(9) = "XC": Tens$(10) = "C"
        H100s$(1) = "C": H100s$(2) = "CC": H100s$(3) = "CCC": H100s$(4) = "CD": H100s$(5) = "D"
        H100s$(6) = "DC": H100s$(7) = "DCC": H100s$(8) = "DCCC": H100s$(9) = "CM": H100s$(10) = "M"
        FOR i = 1 TO 3999
            cd = i: convert$ = ""
            IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M"): cd = cd - 1000 * INT(cd / 1000)
            IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100)): cd = cd - 100 * INT(cd / 100)
            IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10)): cd = cd - 10 * INT(cd / 10)
            IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
            R$(i) = convert$
        NEXT
    END IF
    s$ = _TRIM$(UCASE$(inStr$))
    IF s$ = "" OR s$ = "0" THEN outStr$ = "Error: nada": EXIT SUB 'handle nothing
    FOR i = 1 TO LEN(s$)
        pd = INSTR("0123456789", MID$(s$, i, 1)): pr = INSTR("MDCLXVI", MID$(s$, i, 1))
        IF pd = 0 AND pr = 0 THEN outStr$ = "Error: unknown character.": EXIT SUB 'handle wrong alpha
        IF i > 1 THEN 'check for mixed messages
            IF (lastpd = 0 AND pd > 0) OR (lastpr = 0 AND pr > 0) THEN outStr$ = "Error: digits mixed with letters.": EXIT SUB
        END IF
        lastpd = pd: lastpr = pr
    NEXT
    v = VAL(s$)
    IF v = 0 THEN
        FOR i = 1 TO 3999
            IF R$(i) = s$ THEN outStr$ = _TRIM$(STR$(i)): EXIT SUB
        NEXT
        outStr$ = "Error: Invalid Roman Numeral? string."
    ELSEIF v > 0 AND v < 4000 THEN
        outStr$ = R$(v)
    ELSE
        outStr$ = "Error: Not in range of 1 to 3999."
    END IF
END SUB
 

bplus · « **Reply #22 on:** August 31, 2020, 12:56:28 am »

Code: QB64: [Select]

s$ = _TRIM$(UCASE$(INSTR$))
 

What???

Oh, ha it's supposed to be inStr$ but the forum editor changed it to a keyword even when it had the $.

I wondered because it was capitalizing and trimming leading space when I tested.

Juan Tamarit · « **Reply #23 on:** August 31, 2020, 02:44:29 am »

I understand half the things you guys say, but I still working on the function. So far i made a lot of progress in the user interface
Some matrix-DOS-style

Code: QB64: [Select]

'--------------* Setup *--------------
DATA "","I","II","III","IV","V","VI","VII","VIII","IX","","X","XX","XXX","XL","L","LX","LXX","LXXX","XC","","C","CC","CCC","CD","D","DC","DCC","DCCC","CM","","M","MM","MMM"
 
DIM SHARED resultPieces$(3, 9) 
 
FOR i% = 0 TO 3 
    IF i% < 3 THEN
        FOR ii% = 0 TO 9
            READ resultPieces$(i%, ii%) 
        NEXT ii% 
    ELSE 
        FOR ii% = 0 TO 3 
            READ resultPieces$(i%, ii%) 
        NEXT ii% 
    END IF 
NEXT i% 
 
SCREEN _NEWIMAGE(250, 96, 32) 
CONST WHITE = _RGB32(255, 255, 255) 
CONST YELLOW = _RGB32(255, 255, 0) 
CONST RED = _RGB32(255, 0, 0) 
CONST GREEN = _RGB32(0, 255, 0)
CONST LIGHTGRAY = _RGB32(127, 127, 127) 
CONST DARKGRAY = _RGB32(63, 63, 63) 
 
_TITLE "Arabic/Roman Conversor"
 
DIM actualMenuWorking%
DIM menuHighlight%
 
 
DIM KeyPress$ 
 
actualMenuWorking% = 0
menuHighlight% = 1
 
'--------------* Program V1.2 *--------------
sayHello
DO
    DO
        KeyPress$ = INKEY$
        _LIMIT 30 
        SELECT CASE actualMenuWorking% 
            CASE 0: printMainMenu 
            CASE 1: arabicToRoman
            CASE 2: romanToArabic 
            CASE -1: sayGoodbye 
        END SELECT 
    LOOP UNTIL KeyPress$ <> "" 
 
    IF KeyPress$ = CHR$(13) THEN 
        SELECT CASE menuHighlight% 
            CASE 1: actualMenuWorking% = 1
            CASE 2: actualMenuWorking% = 2
            CASE 3: actualMenuWorking% = -1
        END SELECT 
    ELSEIF KeyPress$ = CHR$(0) + "H" THEN 
        IF menuHighlight% <> 1 THEN menuHighlight% = menuHighlight% - 1 
    ELSEIF KeyPress$ = CHR$(0) + "P" THEN 
        IF menuHighlight% <> 3 THEN menuHighlight% = menuHighlight% + 1 
    ELSEIF KeyPress$ = CHR$(27) THEN 
        menuHighlight% = 3 
    END IF 
 
LOOP
 
 
'--------------* Functions *--------------
FUNCTION turnIntegerToRoman$ (inputNumber%)
 
    numberAsString$ = LTRIM$(STR$(inputNumber%)) 
    IF inputNumber% > 0 AND inputNumber% < 4000 THEN
        digits% = LEN(numberAsString$)
        REDIM tmpArray%(digits%)
        REDIM subResult$(digits%)
        FOR i% = 0 TO digits% - 1
            tmpArray%(i%) = VAL(MID$(numberAsString$, digits% - i%, 1))
            subResult$(i%) = resultPieces$(i%, tmpArray%(i%))
            result$ = subResult$(i%) + result$
        NEXT i%
        COLOR GREEN
        turnIntegerToRoman$ = result$
    ELSE
        COLOR RED
        turnIntegerToRoman$ = "I can't convert " + numberAsString$
    END IF
 
END FUNCTION
 
'- - - - - - - - - - - - - - - - - - - - - -
FUNCTION turnRomanToInteger$ (inputRoman$) ' in process
 
    DIM subResult$
    subResult$ = ""
 
    FOR i% = 3 TO 0 STEP -1
        IF i% = 3 THEN
            FOR ii% = 3 TO 0 STEP -1
                IF INSTR(inputRoman$, resultPieces$(i%, ii%)) THEN
                    subResult$ = subResult$ + LTRIM$(STR$(ii%))
                    EXIT FOR
                END IF
            NEXT ii%
        ELSE
            FOR ii% = 9 TO 0 STEP -1
                IF INSTR(inputRoman$, resultPieces$(i%, ii%)) THEN
                    subResult$ = subResult$ + LTRIM$(STR$(ii%))
                    EXIT FOR
                END IF
            NEXT ii%
        END IF
    NEXT i%
 
    IF subResult$ <> "" THEN
        COLOR GREEN
        turnRomanToInteger$ = subResult$
    ELSE
        COLOR RED
        turnRomanToInteger$ = "Not a roman!"
    END IF
 
END FUNCTION
 
'--------------* Subroutines *--------------
SUB sayHello ()
 
    helloMessage1$ = "         Hello master"
    helloMessage2$ = "  Order me and i will obey..."
 
    COLOR GREEN
 
    i% = 0 
    DO 
        _DELAY .05 
        i% = i% + 1
        buildingMessage$ = LEFT$(helloMessage1$, i%) + CHR$(219) 
        LOCATE 3, 1 
        PRINT buildingMessage$ 
    LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage1$) + 1 
    LOCATE CSRLIN - 1, LEN(helloMessage1$) + 1: PRINT " " 
 
    i% = 0 
    DO 
        _DELAY .05 
        i% = i% + 1 
        buildingMessage$ = LEFT$(helloMessage2$, i%) + CHR$(219) 
        LOCATE 4, 1 
        PRINT buildingMessage$ 
    LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage2$) + 1 
    LOCATE CSRLIN - 1, LEN(helloMessage2$) + 1: PRINT " " 
 
    SLEEP 2
    CLS
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB printMainMenu ()
 
    SHARED menuHighlight%
 
    CLS
 
    LOCATE 1, 1 
    COLOR WHITE 
    PRINT "     Roman/Arabic Conversor"; 
    LOCATE 2, 1 
    PRINT SPACE$(5);: PRINT STRING$(22, CHR$(223)); 
 
    IF menuHighlight% = 1 THEN 
        COLOR YELLOW 
        LOCATE 3, 7 
        PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27); 
    ELSE 
        COLOR DARKGRAY 
    END IF 
    LOCATE 3, 9 
    PRINT "Arabic  Roman"; 
 
    IF menuHighlight% = 2 THEN 
        COLOR YELLOW 
        LOCATE 4, 7 
        PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27); 
    ELSE 
        COLOR DARKGRAY 
    END IF 
    LOCATE 4, 9 
    PRINT "Roman  Arabic"; 
 
    IF menuHighlight% = 3 THEN 
        COLOR YELLOW 
        LOCATE 5, 12 
        PRINT CHR$(26);: PRINT SPACE$(6);: PRINT CHR$(27); 
    ELSE 
        COLOR DARKGRAY 
    END IF 
    LOCATE 5, 14 
    PRINT "Exit"; 
 
    COLOR WHITE 
    LOCATE 6, 1 
    PRINT " UP-DOWN select / ENTER choose"; 
 
    _DISPLAY
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB arabicToRoman ()
 
    SHARED actualMenuWorking%
 
    subInput$ = ""
    num% = 0
 
    DO
        DO 
            CLS 
            COLOR WHITE 
            LOCATE 1, 1 
            PRINT "Give me a number from 1 to 3999" 
            PRINT "     Press ESC to go back" 
            PRINT "          > ";: PRINT subInput$ + CHR$(95) 
            PRINT
            PRINT num%; "= "; turnIntegerToRoman$(num%); 
            KeyPress$ = INKEY$ 
            _LIMIT 40 
            _DISPLAY 
        LOOP UNTIL KeyPress$ <> "" 
 
        'NUMBERS
        IF (ASC(KeyPress$) > 47 AND ASC(KeyPress$) < 58) THEN 'if NUMBER pressed and the subInput$ is not longer
            IF LEN(subInput$) < 4 THEN subInput$ = subInput$ + KeyPress$ '    than 4 then increase the subInput$
 
            'BACKSPACE
        ELSEIF KeyPress$ = CHR$(8) THEN '                   if BACKSPACE pressed and subInput ain't null
            IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
 
            ' ENTER
        ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
            IF subInput$ <> "" THEN '       subInput$ ain't null then
                num% = VAL(subInput$) '     turn to a value and save it to num%
                subInput$ = "" '            and clear subInput$
            END IF
        END IF
 
        'ESC
    LOOP UNTIL KeyPress$ = CHR$(27)
    actualMenuWorking% = 0
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB romanToArabic ()
 
    SHARED actualMenuWorking%
 
    subInput$ = ""
    lastInput$ = "I"
 
    DO
        DO 
            CLS 
            COLOR WHITE 
            LOCATE 1, 1 
            PRINT "Give me a number from 1 to 3999" 
            PRINT "     Press ESC to go back" 
            PRINT "      > ";: PRINT subInput$ + CHR$(95) 
            PRINT
            PRINT " "; lastInput$; "= "; turnRomanToInteger$(lastInput$); 
            KeyPress$ = INKEY$ 
            _LIMIT 40 
            _DISPLAY 
        LOOP UNTIL KeyPress$ <> "" 
 
        'LETTERS
        IF LEN(subInput$) < 15 THEN ' if roman not longer than 15 (MMMDCCCLXXXVIII)
            SELECT CASE ASC(KeyPress$) ' only valid letters
                CASE 73 OR 105: subInput$ = subInput$ + KeyPress$ ' I
                CASE 86 OR 118: subInput$ = subInput$ + KeyPress$ ' V
                CASE 88 OR 120: subInput$ = subInput$ + KeyPress$ ' X
                CASE 76 OR 108: subInput$ = subInput$ + KeyPress$ ' L
                CASE 67 OR 99: subInput$ = subInput$ + KeyPress$ '  C
                CASE 68 OR 100: subInput$ = subInput$ + KeyPress$ ' D
                CASE 77 OR 109: subInput$ = subInput$ + KeyPress$ ' M
            END SELECT
        END IF
 
        'BACKSPACE
        IF KeyPress$ = CHR$(8) THEN ' if BACKSPACE pressen and subInput ain't null
            IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
 
            ' ENTER
        ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
            IF subInput$ <> "" THEN '       subInput$ ain't null then
                lastInput$ = subInput$ '    do as user says
                subInput$ = "" '            and clear subInput$
            END IF
        END IF
 
        subInput$ = UCASE$(subInput$) ' in case user dosn't use uppers
 
        'ESC
    LOOP UNTIL KeyPress$ = CHR$(27)
    actualMenuWorking% = 0
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB sayGoodbye ()
 
    CLS
 
    goodbyeMessage$ = "Have a nice day!"
 
    COLOR RED 
    LOCATE 3, 7
    PRINT CHR$(3) 
    LOCATE 3, 26 
    PRINT CHR$(3)
 
    COLOR GREEN 
    i% = 0 
    DO 
        _DELAY .05 
        i% = i% + 1
        buildingMessage$ = LEFT$(goodbyeMessage$, i%) 
        LOCATE 3, 9 
        PRINT buildingMessage$ 
        _DISPLAY 
    LOOP UNTIL LEN(buildingMessage$) = LEN(goodbyeMessage$) 
 
    SLEEP 2 
    SYSTEM 
 
END SUB
 
 

If i only knew more string manipulation... I'll keep loking... some LEFT$ now, maybe...

But at least i done the Esc thing i wanted, and works cool

Nice work bplus! But i'm too newbie, i can't easely read it yet... You loaded the DATA again? or is it like part of the SUB? i'm sorry if i sound stupid, but can u guys name variables a bit more self explainatorie? XD

I'm learning a lot with this little program! Didn't imagine that could be took so far... Thank you guys! I'll keep working!

bplus · « **Reply #24 on:** August 31, 2020, 03:06:21 am »

Hi @Juan Tamarit

I put the Roman symbols directly into 3 arrays: ones, tens and h100s (hundreds).

Tell you what while waiting for a Run to finish I will add more comments to my code.

Juan Tamarit · « **Reply #25 on:** August 31, 2020, 03:17:14 am »

Thank you bro, i'm really interested on what you talking, but u didn't used the original array?

Did you like the GUI i made? =) i did lit the fireworks at last hehehe

BUT STILL HAVE TO MAKE THAT FUNCTION WORKS BY MY OWN! Personal obsesion thing, you know... XD

Cheers, bro!

bplus · « **Reply #26 on:** August 31, 2020, 04:04:19 am »

Brother! ;-))

I will check out your code opus when it's not 4 AM and my eyes too blurry to see.

Here are my comments as promised, read 'em and leap ;-)) (with joy from enlightenment)

Code: QB64: [Select]

_TITLE "Roman SUB Test" ' B+ 2020-08-30 rewrite old to one sub, using several hints from SMcNeill
 
 
'I hope you can understand how this testing part works :)
DO
    PRINT " Testing conversion of numbers 1 to 3999 to or from Roman Numerals >"
    INPUT " Enter a string to test "; test$
 
    'Here is the crucial call to the SUB we are testing.
    Roman test$, RETURN$
    PRINT " The Roman SUB returned: "; RETURN$
    PRINT
LOOP UNTIL test$ = ""
 
 
 
SUB Roman (inStr$, outStr$) ' 1 to 3999  The inStr$ variable brings in a decimal or a Roman Numeral
    '                         and Roman SUB will output the conversion or an Error: message in outStr$.
 
    STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10), R$(1 TO 3999)
    'STATIC preserves all values between calls to the SUB procedure.
 
 
    IF Ones$(10) = "" THEN 'setup our arrays
        'If Ones$(10) = "" then this is very first time this sub is called, so load up the arrays of data.
 
        'directly load data into the arrays without READ and DATA statements
        Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
        Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
        Tens$(1) = "X": Tens$(2) = "XX": Tens$(3) = "XXX": Tens$(4) = "XL": Tens$(5) = "L"
        Tens$(6) = "LX": Tens$(7) = "LXX": Tens$(8) = "LXXX": Tens$(9) = "XC": Tens$(10) = "C"
        H100s$(1) = "C": H100s$(2) = "CC": H100s$(3) = "CCC": H100s$(4) = "CD": H100s$(5) = "D"
        H100s$(6) = "DC": H100s$(7) = "DCC": H100s$(8) = "DCCC": H100s$(9) = "CM": H100s$(10) = "M"
 
 
        'R is for Roman, the R$() array will hold all the Roman Numeral Strings from 1 to 3999.
        FOR i = 1 TO 3999
 
            cd = i 'cd originally stood for copy decimal from original Decimal2Roman function,
            '       here I just kept the name for decimal numbers.
 
            convert$ = "" ' I am converting the decimal number to Roman,
            '               this variable is storing the building of the Roman string.
 
            'Building from decimal 1000's:
            ' INT(cd / 1000) is how many 1000's the number cd has.
            ' The STRING$ function creates repeated characters, so repeating M the number of 1000's I have.
            IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M")
 
            'Take away 1000's in build, whats left is back in cd.
            cd = cd - 1000 * INT(cd / 1000)
 
 
            'Now how many 100's do I have?  This many = INT(cd / 100). Lookup that number in h100s$() symbols.
            'If it was 5 then h100s$(5) = "D", add that to my build variable convert$.
            IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100))
 
            'And sutract my 100's from cd.
            cd = cd - 100 * INT(cd / 100)
 
            'Now how many 10's do I have?  This many = INT(cd / 10), use that number for index to Tens$() lookup symbol.
            'and add it to convert$.
            IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10))
 
            'And subtract 10's from cd.
            cd = cd - 10 * INT(cd / 10)
 
            'And finally for ones place of decimal number cd is all that remains lookup the symbol in Ones$()
            'and add it to convert$.
            IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
 
            'OK the Roman Numeral string is built in the variable convert$, save it in our big R$() array.
            R$(i) = convert$
        NEXT
 
        'we are now done with all setup and ready to start converting number by array lookups
    END IF
 
 
 
    'Make a copy of instr$ it could be decimal or it could be Roman we don't know yet,
    ' but we want to make sure spaces are trimmed and any letters are capitalized.
    's is for string!
    s$ = _TRIM$(UCASE$(inStr$))
 
    ' Let's get rid of trivial error cases first.
    IF s$ = "" OR s$ = "0" THEN outStr$ = "Error: nada": EXIT SUB 'handle nothing
 
    ' Now is inStr$ all decimal digits or all Roman Letters or something that indicates an error?
    FOR i = 1 TO LEN(s$)
 
        '  pd is for place of digit.                pr is for place of Roman Letter.
        pd = INSTR("0123456789", MID$(s$, i, 1)): pr = INSTR("MDCLXVI", MID$(s$, i, 1))
 
        ' If both are 0 then there is a crazy character on the loose, time to bug out!
        IF pd = 0 AND pr = 0 THEN outStr$ = "Error: unknown character.": EXIT SUB 'handle wrong alpha
 
        ' Here we compare the pd to the last pd and pr to the last pr to check for mixed messages.
        ' If the current character is Roman and the last was a decimal then WTH? letters are mixed with digits.
        ' Time to get out of Dodge!
        IF i > 1 THEN 'check for mixed messages
            IF (lastpd = 0 AND pd > 0) OR (lastpr = 0 AND pr > 0) THEN outStr$ = "Error: digits mixed with letters.": EXIT SUB
        END IF
 
        'save for comparing the next characters
        lastpd = pd: lastpr = pr
    NEXT
 
 
    'OK we have checked that all the characters are either all Roman letters OR all decimal digits.
    ' Time to lay our cards on the table and see which is which from VAL function.
    v = VAL(s$)
 
 
    IF v = 0 THEN ' Then it must be that s$ was all letters that have no value to VAL.
        FOR i = 1 TO 3999 ' So run through the table of Roman strings and match it to what we have in s$.
 
            'Aha a match at i = something, then i is the decimal number for that Roman String.
            'Ship it out in the outStr$ variable, trimmed nice and neat of spaces STR$ tends to add to positive numbers.
            IF R$(i) = s$ THEN outStr$ = _TRIM$(STR$(i)): EXIT SUB
        NEXT
 
        'If we are still in this SUB that means we did not find a matching string, so sorry ;(
        outStr$ = "Error: Invalid Roman Numeral? string."
 
    ELSEIF v > 0 AND v < 4000 THEN ' in range of our array
        'Else s$ has been loaded with digits all this time but are the digits in range of our Roman Numbers?
 
 
        ' Yes it is safe to call on index v of R$(), there will be a Roman Numeral ready to ship out in outStr$,
        ' so put it there.
        outStr$ = R$(v)
 
 
    ELSE
        ' We are not in range, so report a complaint ;(
        outStr$ = "Error: Not in range of 1 to 3999."
    END IF
END SUB
 
 
 

EDIT: I went over my comments and cleaned up some missing: letters, words, punctuation and thoughts.
EDIT 2: (2020-08-31 12:30PM more changes)

TempodiBasic · « **Reply #27 on:** August 31, 2020, 02:18:03 pm »

@Juan Tamarit
Hi Welcome into this explosive forum...
as you can see many members give their apport to the issue with their own experience and knowledge of programming, of BASIC and of the issue in question....a program can be built in so many ways!

I come back to your first program and here my feedbacks, also if I have seen that you are trying to hang yourself with GOTO and DATA and READ and RESTORE (all good old ways to use stored data into the same EXE)

about
https://www.qb64.org/forum/index.php?topic=2960.msg122151#msg122151

do you want feedback from an user...
1) well done to follow a good teacher in programming
2) wel done to share your thoughts and code here in this forum

3) going to your creature:

3.1 I find it fine but my first thought is:
why do you choose an upper limit of 4000 for conversion?
You can have no limits... see here https://www.math.it/formulario/numeri_romani_convertitore.htm

3.2 It is fine also the red text presentation... but after some conversion it goes away above for the scrolling of output of the program---> I sugget to you to fix this bug using LOCATE for printing output of conversion or otherwise to re PRINT the red text presentation before each output before INPUT statement

3.3 quitting the program using a specific input 0 is an option among so many others
about the zero into the history see here in https://es.wikipedia.org/wiki/Cero
Good Luck and
enjoy yourself with programming in QBASIC/QB64

bplus · « **Reply #28 on:** August 31, 2020, 02:32:17 pm »

Hi @Juan Tamarit

RE: your last code post

Are you sure you are a newbie? Really nice extras with cute: opening screen, menus and closing screen; they are colored and sized nicely. But you know that I bet! ;-))

Decimal 2 Roman fine and Roman to Decimal OK for conventional Roman Numerals but I am getting answers for unconventional strings using Roman letters eg:
LLMM = 2050
CCCCM = 1900
LLLC = 150

You could run a reverse check. Check the "Arabic" form reported from SUB Roman 2 Arabic and then run it through
Arabic 2 Roman SUB and see if the 2 strings match.

Very good work, specially from a newbie, you seem to have mastered arrays and SUB / FUNCTIONs.

I look forward to seeing more of your apps.

bplus · « **Reply #29 on:** August 31, 2020, 03:14:05 pm »

Quote

3.1 I find it fine but my first thought is:
why do you choose an upper limit of 4000 for conversion?
You can have no limits... see here https://www.math.it/formulario/numeri_romani_convertitore.htm

Not really, beyond 4000 it gets quite silly stringing MMMMMMMMMMMMMMMMMMMMMMM's until we get to 100's level

Now we could invent along the Roman Pattern:
what for 5,000 maybe F for Five Thousand but we run out of letters (Yikes MF for 4,000?)
what for 10,000, maybe T for Ten Thousand...

probably have enough letters to do a couple of millions. :) Plus too many letters get dangerous as we see with 4000.

Quote

a program can be built in so many ways!

So True! I was hindered in understanding of Juan's code right at the get go, by the way he did DATA and READ it into arrays. Oh, he is setting up for going beyond 1000, aha! There is 0 to 3 levels but the 3rd is incomplete.

News:

Author Topic: Decimal to roman numbers converter (Read 10135 times)

Richard Frost

Re: Decimal to roman numbers converter

SMcNeill

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

SMcNeill

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

SMcNeill

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

TempodiBasic

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter