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

SMcNeill · « **Reply #30 on:** August 31, 2020, 04:37:45 pm »

Beyond 3999, Roman numerals involve multiplication.

For example, 4000 is IV M. The IV represents 4, M represents 1000, so it's 4 * 1000.
5000 is V M.
6000 is VI M.

Notice the space between the multiplier and the 1000s digit, which means M M would be 1,000 * 1,000, or 1,000,000. II M M, by this ruleset would be 2 * 1000 * 1000 = 2,000,000.

Note 2: In cases where spaces are hard to notice, multipliers often have a solid bar above them, such as:

__
IV = 4 multiplier

_
V = 5 multiplier

__
IVM = 4000

__
IVMI = 4001.. Ect..

Juan Tamarit · « **Reply #31 on:** August 31, 2020, 06:42:07 pm »

Guys, don't sweat it, V1.2 is complete and fully operational, GUI included

bplus's FOR i% = 1 to 3999 inspired me, so i used the first function to make a temporal roman and compare it with user input

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 '                º load DATA in
            READ resultPieces$(i%, ii%) ' º this array
        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) '           º set screen size
CONST GREEN = _RGB32(0, 255, 0) '         º and colors
CONST LIGHTGRAY = _RGB32(127, 127, 127) ' º
CONST DARKGRAY = _RGB32(63, 63, 63) '  ÍÍÍ¼
 
_TITLE "Arabic/Roman Conversor"
 
DIM actualMenuWorking%
DIM menuHighlight%
 
 
DIM KeyPress$ ' key press by user
 
actualMenuWorking% = 0
menuHighlight% = 1
 
'--------------* Program V1.2 *--------------
sayHello
DO
 
    DO '                         ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
        KeyPress$ = INKEY$ '                             º get a key
        _LIMIT 20 '                                      º from user
        SELECT CASE actualMenuWorking% ' Í»              º
            CASE 0: printMainMenu '       º              º
            CASE 1: arabicToRoman '       º what do      º
            CASE 2: romanToArabic '       º we do?       º
            CASE -1: sayGoodbye '         º              º
        END SELECT '                     Í¼              º
    LOOP UNTIL KeyPress$ <> "" ' ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼
 
    IF KeyPress$ = CHR$(13) THEN ' if ENTER pressed                   ÍÍÍÍÍ»
        SELECT CASE menuHighlight% '                                       º
            CASE 1: actualMenuWorking% = 1 '                               º
            CASE 2: actualMenuWorking% = 2 '                               º analyze and react
            CASE 3: actualMenuWorking% = -1 '                              º to user input for
        END SELECT '                                                       º the MAIN MENU
    ELSEIF KeyPress$ = CHR$(0) + "H" THEN ' if UP arrow pressed            º
        IF menuHighlight% <> 1 THEN menuHighlight% = menuHighlight% - 1 '  º
    ELSEIF KeyPress$ = CHR$(0) + "P" THEN ' if DOWN arrow pressed          º
        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%)) '                              turn number into s string, no spaces
    IF inputNumber% > 0 AND inputNumber% < 4000 THEN '                          check if number inside range
        digits% = LEN(numberAsString$) '                                        how many digits it has?
        REDIM tmpArray%(digits%) '                                              make an integer array of that many digits long
        REDIM subResult$(digits%) '                                             and another one, but string type, forbuilding the result
        FOR i% = 0 TO digits% - 1 '                                             cicle for every digit
            tmpArray%(i%) = VAL(MID$(numberAsString$, digits% - i%, 1)) '       save in the integer array the value of the digit
            subResult$(i%) = resultPieces$(i%, tmpArray%(i%)) '                 in the string array save the piece according with value and
            result$ = subResult$(i%) + result$ '                                keep building result with pieces untill finish cicling
        NEXT i%
        COLOR GREEN '                                                           since numbar was in range we are allowed to send a good answer
        turnIntegerToRoman$ = result$ '                                         wich we just built
    ELSE '                                                                      but if number was not in range
        COLOR RED '                                                             something bad happenen, so red color
        turnIntegerToRoman$ = "I can't convert " + numberAsString$ '            and we warn about it
    END IF
 
END FUNCTION
 
'- - - - - - - - - - - - - - - - - - - - - -
FUNCTION turnRomanToInteger$ (inputRoman$)
 
    tmpRomanToCompare$ = "" '                                                   we make a temporary variable to place built romans to compare with user input
 
    FOR i% = 3999 TO 1 STEP -1 '                                                we gonna check all possible numbers
        tmpRomanToCompare$ = turnIntegerToRoman$(i%) '                          make a temporal roman number
        IF tmpRomanToCompare$ = inputRoman$ THEN '                              and compare to user input
            COLOR GREEN '                                                       if its the same is all good
            turnRomanToInteger$ = LTRIM$(STR$(i%)) '                            we can send the result as string, no spaces
            EXIT FUNCTION '                                                     and leave here
        END IF
    NEXT i%
 
    COLOR RED '                                                                 but if no coincidence was made something is wrong
    turnRomanToInteger$ = "Not a roman!" '                                      we should warn it
 
END FUNCTION
 
'--------------* Subroutines *--------------
SUB sayHello ()
 
    helloMessage1$ = "       Hello my master"
    helloMessage2$ = "  Order me and i will obey..."
 
    COLOR GREEN
 
    i% = 0 '                                                   ÍÍÍÍ»
    DO '                                                           º
        _DELAY .05 '                                               º
        i% = i% + 1 '                                              º print helloMessage1$
        buildingMessage$ = LEFT$(helloMessage1$, i%) + CHR$(219) ' º character by character
        LOCATE 3, 1 '                                              º and erease the cursor
        PRINT buildingMessage$ '                                   º
    LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage1$) + 1 '   º
    LOCATE CSRLIN - 1, LEN(helloMessage1$) + 1: PRINT " " '    ÍÍÍÍ¼
 
    i% = 0 '                                                   ÍÍÍÍ»
    DO '                                                           º
        _DELAY .05 '                                               º
        i% = i% + 1 '                                              º print helloMessage2$
        buildingMessage$ = LEFT$(helloMessage2$, i%) + CHR$(219) ' º character by character
        LOCATE 4, 1 '                                              º and erease the cursor
        PRINT buildingMessage$ '                                   º
    LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage2$) + 1 '   º
    LOCATE CSRLIN - 1, LEN(helloMessage2$) + 1: PRINT " " '    ÍÍÍÍ¼
 
    SLEEP 2
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB printMainMenu ()
 
    SHARED menuHighlight%
 
    CLS
 
    LOCATE 1, 1 '                                          ÍÍÍ»
    COLOR WHITE '                                             º Title
    PRINT "     Roman/Arabic Conversor"; '                 ÍÍÍ¼
    LOCATE 2, 1 '                                          ÍÍÍ»
    PRINT SPACE$(5);: PRINT STRING$(22, CHR$(223)); '      ÍÍÍ¼ Underline
 
    IF menuHighlight% = 1 THEN '                           ÍÍÍ»
        COLOR YELLOW '                                        º
        LOCATE 3, 7 '                                         º
        PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27); ' º
    ELSE '                                                    º Arabic  Roman
        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 '                                                    º Roman  Arabic
        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 '                                                    º Exit
        COLOR DARKGRAY '                                      º
    END IF '                                                  º
    LOCATE 5, 14 '                                            º
    PRINT "Exit"; '                                        ÍÍÍ¼
 
    COLOR WHITE '                                          ÍÍÍ»
    LOCATE 6, 1 '                                             º Instructions
    PRINT " UP-DOWN select / ENTER choose"; '              ÍÍÍ¼
 
    _DISPLAY
 
END SUB
 
'- - - - - - - - - - - - - - - - - - - - - -
SUB arabicToRoman ()
 
    SHARED actualMenuWorking%
 
    subInput$ = ""
    num% = 0
 
    DO
        DO '                         ÍÍ»
            CLS '                      º
            COLOR WHITE '                               ÍÍÍÍ»
            LOCATE 1, 1 '                                   º istructions
            PRINT "Give me a number from 1 to 3999" '       º for user
            PRINT "     Press ESC to go back" '         ÍÍÍÍ¼
            PRINT "          > ";: PRINT subInput$ + CHR$(95) ' what user writes
            PRINT
            PRINT num%; "= "; turnIntegerToRoman$(num%); ' what user want's to see
            KeyPress$ = INKEY$ '       º get a key
            _LIMIT 20 '                º from user
            _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 '                                   º istructions
            PRINT "Give me a number from 1 to 3999" '       º for user
            PRINT "     Press ESC to go back" '         ÍÍÍÍ¼
            PRINT "      > ";: PRINT subInput$ + CHR$(95) ' what user writes
            PRINT
            PRINT " "; lastInput$; " = "; turnRomanToInteger$(lastInput$); ' what user want's to see
            KeyPress$ = INKEY$ '       º get a key
            _LIMIT 20 '                º from user
            _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) '                                             º Hearts
    LOCATE 3, 26 '                                              º
    PRINT CHR$(3) '                                          ÍÍÍ¼
 
    COLOR GREEN '                                            ÍÍÍ»
    i% = 0 '                                                    º
    DO '                                                        º print goodbyeMessage$
        _DELAY .05 '                                            º character by character
        i% = i% + 1 '                                           º
        buildingMessage$ = LEFT$(goodbyeMessage$, i%) '         º
        LOCATE 3, 9 '                                           º
        PRINT buildingMessage$ '                                º
        _DISPLAY '                                              º
    LOOP UNTIL LEN(buildingMessage$) = LEN(goodbyeMessage$) 'ÍÍÍ¼
 
    SLEEP 2 '                                                ÍÍÍ»
    SYSTEM '                                                 ÍÍÍ¼ Wait & kill
 
END SUB

Juan Tamarit · « **Reply #32 on:** August 31, 2020, 07:23:45 pm »

I see u guys wondering about numbers beyond 3999... indeed, for a value of 4000 it should say IV with a line over it. I could find a way to do this, but i feel satisfied with the actual result, it accomplished my expectations.
Thanks to everyone for the warm welcome, pacient feedback and great ideas! I'll keep thinking in the next proyect! =)
Of course, if anyone want´s to try to make the code smaller or finds another way to do this it will be nicely welcome
Cheers, good people!

FellippeHeitor · « **Reply #33 on:** August 31, 2020, 07:27:57 pm »

Very nice minimalistic interface, and sweet good-bye message. Good job!

Juan Tamarit · « **Reply #34 on:** August 31, 2020, 07:44:15 pm »

Wow! You Felipe? The one of the youtube/radio program? Thank you very much for develop the QB64! I find it to be a perfect vehicle for my ideas! Count on me if you need help with something, i'll try to squeeze my head.

And thanks Terry too! I can say how much his site has tought me (along some discipline from me). I still have to finish the course! i just reached task 14 for audio, hehehe, we could add some BEEPS to the converter ahahahah XD

I was think in a moment of random frecuencies while "thinking" the answer... i avoided for the moment, targeting staright to the missing function.

What i still will like to do is the "load-DATA-only-for-the-function-then clear-it". I know this program is not memory consuming, but if somebody wants to use, say in a text to voice program i want t make sure things are in it's place. (Interesting: voice finds a valid roman and "read" it as integer, but that's for advancer programmers who works on AI's, right?)

FellippeHeitor · « **Reply #35 on:** August 31, 2020, 08:56:58 pm »

Just another cog in the machine, we're all fans of Galleon's great work.

Glad to have you in the community. What's your history with programming so far?

Juan Tamarit · « **Reply #36 on:** August 31, 2020, 09:48:29 pm »

Quote from: FellippeHeitor on August 31, 2020, 08:56:58 pm

Glad to have you in the community. What's your history with programming so far?

Glad to be here! =) A i said i'm a chemistry technician, i had a veeeryyy basic aproach to programming in the general curriculum (we used QBASIC at the school! in 2001), so i understood the concept of an IF statement and 2 or 3 things more. No more programming in my life UNTIL some years ago electronics came in as a hobby (some components still there on the shelve) and i started on a forum (that's why i'm here). Electronics took me to Arduino. After a single succeded proyect (but a lot of learning both in programming an electronics) no more programming in my life UNTIL i wanted to make my game, i started with GameMaker 8.1, never succeded in my target, but still a lot of learning and exploration. I decided to try another way, so i looked back to my start... and QB64 and St Terrie's appeard. After 14 chapters of course an idea came out (the arabic>roman). I did it and decided to check with others (as first post says), the rest is on the posts and now with my first program from scratch just built.

And here i am now, bro =) On the seventh day i rested XD

'------------* EDIT *-----------

Question: in my function turnIntegerToRoman$() i use REDIM, but i was thinking if thats correct or should just be DIM, or if no need to declarate (i think they need it because they are arrays). By the way, i can't place an array inside a TYPE...END TYPE, isn't it?

bplus · « **Reply #37 on:** August 31, 2020, 10:22:32 pm »

Yes nice! Table lookup was so much easier to check if Roman was legit, thanks for idea Steve.

euklides · « **Reply #38 on:** September 01, 2020, 03:09:05 am »

I use since years this little program:

(Put a value in 'anr')

ANR = 2020
GOSUB romain
PRINT rom$
END

romain: aro# = ANR: IF aro# < 0 THEN rom$ = "Zéro": RETURN
IF aro# > 3999 THEN rom$ = "????": RETURN
IF aro# >= 3000 THEN rom$ = rom$ + "MMM": aro# = aro# - 3000
IF aro# >= 2000 THEN rom$ = rom$ + "MM": aro# = aro# - 2000
IF aro# >= 1000 THEN rom$ = rom$ + "M": aro# = aro# - 1000
IF aro# >= 900 THEN rom$ = rom$ + "CM": aro# = aro# - 900
IF aro# >= 800 THEN rom$ = rom$ + "DCCC": aro# = aro# - 800
IF aro# >= 700 THEN rom$ = rom$ + "DCC": aro# = aro# - 700
IF aro# >= 600 THEN rom$ = rom$ + "DC": aro# = aro# - 600
IF aro# >= 500 THEN rom$ = rom$ + "D": aro# = aro# - 500
IF aro# >= 400 THEN rom$ = rom$ + "CD": aro# = aro# - 400
IF aro# >= 300 THEN rom$ = rom$ + "CCC": aro# = aro# - 300
IF aro# >= 200 THEN rom$ = rom$ + "CC": aro# = aro# - 200
IF aro# >= 100 THEN rom$ = rom$ + "C": aro# = aro# - 100
IF aro# >= 90 THEN rom$ = rom$ + "XC": aro# = aro# - 90
IF aro# >= 80 THEN rom$ = rom$ + "LXXX": aro# = aro# - 80
IF aro# >= 70 THEN rom$ = rom$ + "LXX": aro# = aro# - 70
IF aro# >= 60 THEN rom$ = rom$ + "LX": aro# = aro# - 60
IF aro# >= 50 THEN rom$ = rom$ + "L": aro# = aro# - 50
IF aro# >= 40 THEN rom$ = rom$ + "XL": aro# = aro# - 40
IF aro# >= 30 THEN rom$ = rom$ + "XXX": aro# = aro# - 30
IF aro# >= 20 THEN rom$ = rom$ + "XX": aro# = aro# - 20
IF aro# >= 10 THEN rom$ = rom$ + "X": aro# = aro# - 10
IF aro# >= 9 THEN rom$ = rom$ + "IX": aro# = aro# - 9
IF aro# >= 8 THEN rom$ = rom$ + "VIII": aro# = aro# - 8
IF aro# >= 7 THEN rom$ = rom$ + "VII": aro# = aro# - 7
IF aro# >= 6 THEN rom$ = rom$ + "VI": aro# = aro# - 6
IF aro# >= 5 THEN rom$ = rom$ + "V": aro# = aro# - 5
IF aro# >= 4 THEN rom$ = rom$ + "IV": aro# = aro# - 4
IF aro# >= 3 THEN rom$ = rom$ + "III": aro# = aro# - 3
IF aro# >= 2 THEN rom$ = rom$ + "II": aro# = aro# - 2
IF aro# >= 1 THEN rom$ = rom$ + "I": aro# = aro# - 1
RETURN

Ashish · « **Reply #39 on:** September 01, 2020, 03:24:43 am »

Good program Juan!
Here is my approach (I'm using Steve idea for number greater than 3999):

Code: QB64: [Select]

_TITLE "Arabic To Roman : By Ashish"
TYPE dict
    c AS STRING * 2 'roman literal
    n AS _UNSIGNED INTEGER 'its equivalent in arabic
END TYPE
 
DIM SHARED roman_literal(12) AS dict
FOR i = 0 TO UBOUND(roman_literal) 'store the value in the array
    READ roman_literal(i).n, roman_literal(i).c
NEXT
q~& = -1
DIM num AS _UNSIGNED LONG
PRINT "Arabic to Roman Converter [ 1 to "; q~&; "] : By Ashish"
DO
    INPUT ">", num
    PRINT ArabicToRoman(num)
LOOP UNTIL num = 0
DATA 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"
 
FUNCTION ArabicToRoman$ (n~&)
    IF n~& >= 4000 THEN
        k~& = INT(n~& / 1000)
        ArabicToRoman$ = ArabicToRoman$(k~&) + " " + ArabicToRoman$(n~& - (k~& - 1) * 1000)
    ELSE
        IF n~& = 0 THEN PRINT "invalid": EXIT FUNCTION
        ArabicToRoman$ = __internal_convertArabicToRoman(n~&)
    END IF
END FUNCTION
FUNCTION __internal_convertArabicToRoman$ (n~&)
    i~& = UBOUND(roman_literal)
    x~& = n~&
    DO
        IF x~& >= roman_literal(i~&).n AND x~& < 4 * roman_literal(i~&).n THEN
            p~& = INT(x~& / roman_literal(i~&).n)
            __internal_convertArabicToRoman$ = __internal_convertArabicToRoman$ + strRepeat(p~&, roman_literal(i~&).c)
            x~& = x~& - (roman_literal(i~&).n * p~&)
        ELSE
            i~& = i~& - 1 'move below in the array
        END IF
    LOOP UNTIL x~& = 0
END FUNCTION
FUNCTION strRepeat$ (n AS _UNSIGNED _INTEGER64, s AS STRING)
    s = RTRIM$(s)
    FOR i~& = 1 TO n
        strRepeat$ = strRepeat$ + s
    NEXT
END FUNCTION
 

bplus · « **Reply #40 on:** September 01, 2020, 11:37:41 am »

Hi @Ashish

Code: QB64: [Select]

DO
    INPUT ">", num
    PRINT ArabicToRoman(num)
LOOP UNTIL num = 0
 

Need to DIM num as _UNSIGNED LONG so some fool who types in the top limit wont get an "invalid" message.

I am still checking out how you handle conversions, very interesting.

Hi @euklides

Code: QB64: [Select]

IF aro# < 0 THEN rom$ = "Zéro": RETURN  

Might want <= 0 because absolutely nothing gets returned for aro# = 0

I like your straight forward no nonsense approach!

Man it is so interesting to see the different approaches to same problem!

Ashish · « **Reply #41 on:** September 01, 2020, 11:44:28 am »

@bplus thanks. I have just edited it. :)

bplus · « **Reply #42 on:** September 01, 2020, 12:16:47 pm »

I modified @euklides for ~~multiple testing of romain GOSUB:~~ for handy FUNCTION and to do multiple tests:

Code: QB64: [Select]

'ANR = 2020 'Euklides vers 2020-09-01 https://www.qb64.org/forum/index.php?topic=2960.msg122293#msg122293
'GOSUB romain
'PRINT rom$
'END
 
'>>> b+ mod to convert to handy Function  2020-09-01
DO
    PRINT: PRINT "0 or less quits"
    INPUT "Enter 1 to 3999 a number to convert to Roman: "; anr
    PRINT "romain returned "; romain$(anr)
    IF anr <= 0 THEN END
LOOP
 
FUNCTION romain$ (anr)
    aro# = anr 'copy anr so it's not changed
    IF aro# <= 0 THEN romain$ = "Zéro": EXIT FUNCTION '<<< add = to < for compare
    IF aro# > 3999 THEN romain$ = "????": EXIT FUNCTION
    IF aro# >= 3000 THEN rom$ = rom$ + "MMM": aro# = aro# - 3000
    IF aro# >= 2000 THEN rom$ = rom$ + "MM": aro# = aro# - 2000
    IF aro# >= 1000 THEN rom$ = rom$ + "M": aro# = aro# - 1000
    IF aro# >= 900 THEN rom$ = rom$ + "CM": aro# = aro# - 900
    IF aro# >= 800 THEN rom$ = rom$ + "DCCC": aro# = aro# - 800
    IF aro# >= 700 THEN rom$ = rom$ + "DCC": aro# = aro# - 700
    IF aro# >= 600 THEN rom$ = rom$ + "DC": aro# = aro# - 600
    IF aro# >= 500 THEN rom$ = rom$ + "D": aro# = aro# - 500
    IF aro# >= 400 THEN rom$ = rom$ + "CD": aro# = aro# - 400
    IF aro# >= 300 THEN rom$ = rom$ + "CCC": aro# = aro# - 300
    IF aro# >= 200 THEN rom$ = rom$ + "CC": aro# = aro# - 200
    IF aro# >= 100 THEN rom$ = rom$ + "C": aro# = aro# - 100
    IF aro# >= 90 THEN rom$ = rom$ + "XC": aro# = aro# - 90
    IF aro# >= 80 THEN rom$ = rom$ + "LXXX": aro# = aro# - 80
    IF aro# >= 70 THEN rom$ = rom$ + "LXX": aro# = aro# - 70
    IF aro# >= 60 THEN rom$ = rom$ + "LX": aro# = aro# - 60
    IF aro# >= 50 THEN rom$ = rom$ + "L": aro# = aro# - 50
    IF aro# >= 40 THEN rom$ = rom$ + "XL": aro# = aro# - 40
    IF aro# >= 30 THEN rom$ = rom$ + "XXX": aro# = aro# - 30
    IF aro# >= 20 THEN rom$ = rom$ + "XX": aro# = aro# - 20
    IF aro# >= 10 THEN rom$ = rom$ + "X": aro# = aro# - 10
    IF aro# >= 9 THEN rom$ = rom$ + "IX": aro# = aro# - 9
    IF aro# >= 8 THEN rom$ = rom$ + "VIII": aro# = aro# - 8
    IF aro# >= 7 THEN rom$ = rom$ + "VII": aro# = aro# - 7
    IF aro# >= 6 THEN rom$ = rom$ + "VI": aro# = aro# - 6
    IF aro# >= 5 THEN rom$ = rom$ + "V": aro# = aro# - 5
    IF aro# >= 4 THEN rom$ = rom$ + "IV": aro# = aro# - 4
    IF aro# >= 3 THEN rom$ = rom$ + "III": aro# = aro# - 3
    IF aro# >= 2 THEN rom$ = rom$ + "II": aro# = aro# - 2
    IF aro# >= 1 THEN rom$ = rom$ + "I": aro# = aro# - 1
    romain$ = rom$
END FUNCTION
 

bplus · « **Reply #43 on:** September 01, 2020, 04:23:48 pm »

@Ashish has beautifully condensed Euklides method AND extended the notation beyond 3999.

Here I condensed Ashish code to one single independent Function of 29 lines AND modified the notation of the Roman numeral multipliers. Since we can't put a bar over the letters (easily, nor repeat it typing on the keyboard), I propose using lower case letters and separating the multiplier from the final digits with a * instead of a space. That way one long number can be easily distinguished from the one next to it or a whole string of long numbers.

Code: QB64: [Select]

_TITLE "Roman MOD post Ashish" 'b+ 2020-09-01 combine Ashish down to one independent Function 29 lines!
q~& = -1
DIM num AS _UNSIGNED LONG
PRINT "Arabic to Roman Converter [ 1 to "; q~&; "] : By Ashish"
DO
    INPUT "Enter Arabic to convert to Roman >", num
    PRINT A2R$(num)
LOOP UNTIL num = 0
FUNCTION A2R$ (nn AS _UNSIGNED LONG) 'Arabic positive integer to Roman string
    STATIC d(12) AS _UNSIGNED LONG, c(12) AS STRING
    DIM n AS _UNSIGNED LONG, k AS _UNSIGNED LONG
    DIM ub AS INTEGER, i AS INTEGER, s AS STRING, p AS _UNSIGNED LONG, x AS _UNSIGNED LONG
    IF d(0) = 0 THEN ' load n and c arrays
        FOR ub = 0 TO 12
            READ d(ub), c(ub)
        NEXT
    END IF
    n = nn 'private copy of nn because we will be recursive
    IF n >= 4000 THEN
        k = INT(n / 1000)
        A2R$ = LCASE$(A2R$(k)) + "*" + A2R$(n - (k - 1) * 1000)
    ELSE
        IF n = 0 THEN PRINT "invalid": EXIT FUNCTION
        ub = 12: x = n
        DO ' *** Ashish uses same method as Euklides but condensed beautifully here ***
            IF x >= d(ub) AND x < 4 * d(ub) THEN ' x falls between which two decimal amounts?
                p = INT(x / d(ub)): s = "" 'setup to copy Roman symbol(s) p times
                FOR i = 1 TO p: s = s + c(ub): NEXT 'string copy
                A2R$ = A2R$ + s: x = x - d(ub) * p
            ELSE
                ub = ub - 1 'move index ub down
            END IF
        LOOP UNTIL x = 0
    END IF
    EXIT FUNCTION 'below is nice condensed data Ashish uses same method as Euklides but condensed beautifully
    DATA 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"
END FUNCTION
 

bplus · « **Reply #44 on:** September 01, 2020, 10:03:06 pm »

Revised and extended Roman$ Function that converts either way handling extended expressions to limit of _UNSIGNED LONG type. I developed this using lower case and * notation. Then when working properly, I converted to all UCASE$ and space between extensions.

Code: QB64: [Select]

OPTION _EXPLICIT
_TITLE "Roman$ Function Test and Demo" ' b+ 2020-09-01 revise Roman SUB to latest changes at forum
DIM q~&, output$, num AS _UNSIGNED LONG, test$
q~& = -1: num = 4294967295 'quick test of big number limit
PRINT num; "= "; Roman$(STR$(num))
'         4294967295    4294967295   'limit
FOR num = 4200000000 TO 4200000020
    output$ = Roman$(STR$(num))
    test$ = Roman$(output$)
    LOCATE CSRLIN, 1: PRINT num;
    LOCATE CSRLIN, 20: PRINT output$;
    LOCATE CSRLIN, 50: PRINT test$
    IF num <> VAL(test$) THEN BEEP: SLEEP
NEXT
DO
    PRINT " Testing conversion of numbers 0 to"; q~&; " to or from Roman Numerals >"
    INPUT " Enter a string to test "; test$
    output$ = Roman$(test$)
    PRINT " The Roman SUB returned: "; output$
    PRINT
LOOP UNTIL test$ = ""
 
FUNCTION Roman$ (instrg$) ' for extended Roman Numeral conversions
    STATIC d(12) AS _UNSIGNED LONG, c(12) AS STRING, R$(1 TO 3999)
    DIM v AS _UNSIGNED LONG, k AS _UNSIGNED LONG, conv AS STRING
    DIM ub AS INTEGER, i AS INTEGER, j AS INTEGER, s AS STRING, p AS _UNSIGNED LONG, x AS _UNSIGNED LONG
    DIM pd AS INTEGER, pr AS INTEGER, lastpd AS INTEGER, lastpr AS INTEGER
    IF d(0) = 0 THEN ' load n and c arrays
        FOR ub = 0 TO 12
            READ d(ub), c(ub)
        NEXT
        FOR i = 1 TO 3999
            ub = 12: x = i: conv = ""
            DO ' *** Ashish uses same method as Euklides but condensed beautifully here ***
                IF x >= d(ub) AND x < 4 * d(ub) THEN ' x falls between which two decimal amounts?
                    p = INT(x / d(ub)): s = "" 'setup to copy Roman symbol(s) p times
                    FOR j = 1 TO p: s = s + c(ub): NEXT 'string copy
                    conv = conv + s: x = x - d(ub) * p
                ELSE
                    ub = ub - 1 'move index ub down
                END IF
            LOOP UNTIL x = 0
            R$(i) = conv
        NEXT
    END IF 'end of setup, one time only
    s = _TRIM$(UCASE$(instrg$))
    IF s = "" OR s = "0" THEN Roman$ = "Error: nada": EXIT FUNCTION 'handle nothing
    FOR i = 1 TO LEN(s) ' character checkup
        pd = INSTR("0123456789", MID$(s, i, 1)): pr = INSTR(" MDCLXVI", MID$(s, i, 1))
        IF pd = 0 AND pr = 0 THEN Roman$ = "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 Roman$ = "Error: digits mixed with letters.": EXIT SUB
        END IF
        lastpd = pd: lastpr = pr
    NEXT
    v = VAL(s) 'is s a number or a Roman Numeral string?
    IF v = 0 THEN
        REDIM vs(0) AS STRING ' vs for value strings
        Split s, " M", vs() '   Handy Split for parsing *M sections
        conv = "" '             Build our string on this variable (reusing)
        FOR j = 0 TO UBOUND(vs)
            pd = 0 'reuse an integer for found match
            FOR i = 1 TO 3999
                IF R$(i) = vs(j) THEN ' When stringing together numbers after first set need 0 fillers.
                    IF j > 0 THEN conv = conv + RIGHT$("000" + _TRIM$(STR$(i)), 3) ELSE conv = conv + _TRIM$(STR$(i))
                    pd = 1: EXIT FOR 'pd indeicates a match was found
                END IF
            NEXT
            IF pd <> 1 THEN ' No match found, maybe this is empty 000 space?
                IF vs(j) = "" THEN conv = conv + "000" ELSE Roman$ = "Error: Invalid Roman Numeral? string.": EXIT FUNCTION
            END IF
        NEXT
        Roman$ = conv
    ELSEIF v >= 4000 THEN ' Beyond our Roman String Table
        k = INT(v / 1000)
        Roman$ = Roman$(STR$(k)) + " " + Roman$(STR$(v - (k - 1) * 1000)) ' Go recursive until v < 4000
    ELSE
        Roman$ = R$(v) 'Table lookup
    END IF
    EXIT SUB 'below is nice condensed data Ashish uses same method as Euklides but condensed beautifully
    DATA 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"
END SUB
 
SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
    DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
    dpos = INSTR(curpos, SplitMeString, delim)
    DO UNTIL dpos = 0
        loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
        curpos = dpos + LD
        dpos = INSTR(curpos, SplitMeString, delim)
    LOOP
    loadMeArray(arrpos) = MID$(SplitMeString, curpos)
    REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
END SUB
 
 

News:

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

SMcNeill

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

FellippeHeitor

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

FellippeHeitor

Re: Decimal to roman numbers converter

Juan Tamarit

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

euklides

Re: Decimal to roman numbers converter

Ashish

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

Ashish

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter

bplus

Re: Decimal to roman numbers converter