QB64.org Forum

Active Forums => Programs => Topic started by: Juan Tamarit on August 28, 2020, 04:01:29 am

Title: Decimal to roman numbers converter
Post by: Juan Tamarit on August 28, 2020, 04:01:29 am
Hello everyone. My first time here. I will like to start by thanking to the QB64 creators, and also to Terry Ritchie, i´ve learned a lot from his site, and still going. I have to confess that i'm not a programmer, i'm a chemistry technician, but i'm a hobbist entusiast, so i want to check out if i'm taking the right direction.

I was wandering if i could make a program to turn decimal numbers to roman, just for the challenge, and i came up with this:

Code: QB64: [Select]
  1. COLOR _RGB(255, 0, 0)
  2. PRINT STRING$(43, "Û")
  3. PRINT "Û Conversor de n£meros ar bicos a romanos Û"
  4. PRINT STRING$(43, "Û")
  5. COLOR _RGB(255, 255, 255)
  6.     INPUT " 1 a 3999, 0 para salir > ", numero% '                       obtener el numero del usuario
  7.     IF numero% > 0 AND numero% < 4000 THEN '                            verificar si el numero esta en rango
  8.         numero$ = LTRIM$(STR$(numero%)) '                               si esta, lo convertimos en string y le sacamos el espacio de adelante
  9.         digitos% = LEN(numero$) '                                       medimos cuantos digitos tiene el numero
  10.         REDIM array%(digitos%) '                                        hacemos un array de esa cantidad de digitos (no vamos a usar el indice 0)
  11.         REDIM resultado$(digitos%) '                                    preparamos otro array para armar la respuesta como string, pero tiene la misma longitud que el de digitos
  12.         FOR i% = 1 TO digitos% '                                        ciclamos por cada digito, desde atras hacia adelante array(1) son las unidades array(3) son las centenas
  13.             array%(i%) = VAL(MID$(numero$, (digitos% + 1) - i%, 1)) '   y vamos guardando en el array sus valores individuales como integer
  14.         NEXT i%
  15.         SELECT CASE array%(1) '                                         caso de las unidades
  16.             CASE 1: resultado$(1) = "I"
  17.             CASE 2: resultado$(1) = "II"
  18.             CASE 3: resultado$(1) = "III"
  19.             CASE 4: resultado$(1) = "IV"
  20.             CASE 5: resultado$(1) = "V"
  21.             CASE 6: resultado$(1) = "VI"
  22.             CASE 7: resultado$(1) = "VII"
  23.             CASE 8: resultado$(1) = "VIII"
  24.             CASE 9: resultado$(1) = "IX"
  25.             CASE 0: resultado$(1) = ""
  26.         END SELECT
  27.         IF digitos% > 1 THEN '                                          no meterse en una dimension que el array no tenga
  28.             SELECT CASE array%(2) '                                     caso de las decenas
  29.                 CASE 1: resultado$(2) = "X"
  30.                 CASE 2: resultado$(2) = "XX"
  31.                 CASE 3: resultado$(2) = "XXX"
  32.                 CASE 4: resultado$(2) = "XL"
  33.                 CASE 5: resultado$(2) = "L"
  34.                 CASE 6: resultado$(2) = "LX"
  35.                 CASE 7: resultado$(2) = "LXX"
  36.                 CASE 8: resultado$(2) = "LXXX"
  37.                 CASE 9: resultado$(2) = "XC"
  38.                 CASE 0: resultado$(2) = ""
  39.             END SELECT
  40.             IF digitos% > 2 THEN '                                      no meterse en una dimension que el array no tenga
  41.                 SELECT CASE array%(3) '                                 caso de las centenas
  42.                     CASE 1: resultado$(3) = "C"
  43.                     CASE 2: resultado$(3) = "CC"
  44.                     CASE 3: resultado$(3) = "CCC"
  45.                     CASE 4: resultado$(3) = "CD"
  46.                     CASE 5: resultado$(3) = "D"
  47.                     CASE 6: resultado$(3) = "DC"
  48.                     CASE 7: resultado$(3) = "DCC"
  49.                     CASE 8: resultado$(3) = "DCCC"
  50.                     CASE 9: resultado$(3) = "CM"
  51.                     CASE 0: resultado$(3) = ""
  52.                 END SELECT
  53.                 IF digitos% > 3 THEN
  54.                     SELECT CASE array%(4) '                             no meterse en una dimension que el array no tenga
  55.                         CASE 1: resultado$(4) = "M" '                   caso de las unidades de mil
  56.                         CASE 2: resultado$(4) = "MM"
  57.                         CASE 3: resultado$(4) = "MMM"
  58.                     END SELECT
  59.                 END IF
  60.             END IF
  61.         END IF
  62.     ELSEIF numero% = 0 THEN '                                           el usuario ingreso 0 y quiere salir del programa
  63.         COLOR _RGB(255, 0, 0)
  64.         PRINT "Los romanos no conocian el 0!"
  65.         PRINT "            "
  66.         SLEEP 3
  67.         SYSTEM
  68.     ELSE '                                                              el usuario ingreso un numero fuera de rango
  69.         PRINT "N£mero fuera de rango"
  70.     END IF
  71.     PRINT " ";
  72.     FOR i% = digitos% TO 1 STEP -1
  73.         PRINT resultado$(i%); '                                         imprimir el resultado digto a digito trasformados
  74.     NEXT i%
  75.     PRINT
  76.     PRINT

I have two questions for the community:

1) How does this program looks to you? Could have I done any better? I'ts a horrible mess? Looks fine?

2) As i learned from Terrie's class I ususally use a DO...LOOP UNTIL _KEYDOWN(27), but in this case i have an INPUT statement inside the loop, pausing it and making these useless. Any way that i can be waiting for a INPUT and if i press ESC go straight to a SYSTEM?

I'm very interested in your replies and critics about these. I'm always trying to learn.
Cheers, people!

JT-chem

(yeah, i know, my english is not very good, but that's another thing to keep learning! Cool! :-)
Title: Re: Decimal to roman numbers converter
Post by: Cobalt on August 28, 2020, 09:36:38 am
2) As i learned from Terrie's class I ususally use a DO...LOOP UNTIL _KEYDOWN(27), but in this case i have an INPUT statement inside the loop, pausing it and making these useless. Any way that i can be waiting for a INPUT and if i press ESC go straight to a SYSTEM?

2 routes you might take;
 1. Use the input to control that, your range is 1 to 3999 so make 0 (or blank) the same as ESC key. Rather than giving the message
     that there is no roman numeral for 0

 2. Write your own input handler. Like a function where it returns 1 of 2 values, the first being -1 which would cause the program to
     exit, the other would be the value to convert to roman numerals.


Rather interesting program though!  If you want to further it some you might try to find a way to use arrays to control the output rather than using SELECT CASE.
Title: Re: Decimal to roman numbers converter
Post by: bplus on August 28, 2020, 01:01:04 pm
Welcome Juan Yamarit

May I ask what language you are using in program?

It works fine and you might like to add:
Code: QB64: [Select]
  1. _TITLE "Convert Decimal Number to Roman 1 to 3999"
for the title bar of screen.
Title: Re: Decimal to roman numbers converter
Post by: SierraKen on August 28, 2020, 01:20:33 pm
Welcome to the forum Juan! Great little app you made there. I made something similar back in the 1990's but I think mine was just a graph for people to convert it in their heads. If you remove the INPUT command and go with INKEY$ then I suggest adding a _LIMIT 20 command right after Line 7 at the start of your DO/LOOP because the INPUT command slows down the computer processing which is good. Without that, the CPU usage would be very high, which you can see in your Windows Task Manager (if you use Windows). _LIMIT 20 slows it down to 20 cycles a second for the whole program. You can use any number, larger programs would need 100, or even larger ones might need 1000, etc. The most I've ever used was 2000. And then there's some programs, which need the full strength of the CPU (which is very uncommon) and those times you just don't use _LIMIT. But like I said, if you keep the INPUT in your LOOP, you don't need it, because INPUT does it's own slowing down.
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 28, 2020, 09:17:21 pm
Thank you for the warm welcome and suggestions!

I'm an argetinian, so the program is written in spanish.

I'll keep a bit more on the Terrie's Ritchies Course, and i will come back over this program with these suggestions. The array sounds interesting. I also was thinking if it was posible to use DATA...READ, or maybe reading a .txt file. But i agree that the CASE SELECT...END CASE looks awfull, was just a very BASIC way to do it. I came in this programming stuff after playing TIS-100, were my rule "make it work first, then optimize".

I'll set the INKEY$ ways soon, i just wondered if can be done simply with INPUT, but you guys are right, untill ENTER is pressed the program is paused, no chance this way.

No title or too many fancy thisng for the moment, but it can be more user friendly. Im more focused at start on a fully operational, clean code program, then we lit the fireworks. XD
The idea would actually be to make a function/snippet that other people of the community can use inside they own programs.

The funny part is gonna be make it work the opposite way: ROMAN in > INTEGER out hehehe

Again thenk you, and sorry for my english. (feel free to correct me on this as well if you like)

Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 28, 2020, 10:39:01 pm
Ok, I tried the following:

Code: QB64: [Select]
  1. 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"
  2. DIM resultPieces$(3, 9)
  3. '
  4. '
  5. FOR i% = 0 TO 3
  6.     FOR ii% = 0 TO 9
  7.         READ resultPieces$(i%, ii%)
  8.     NEXT ii%
  9. NEXT i%

And I'm getting a "Unhandled Error #4: Out of DATA

I'm missing something here? have to confess that never used DATA...READ before, but looks cleany to me

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

Sorry, posted before activating the other brain cell, i already got the thing working

Code: QB64: [Select]
  1. FOR i% = 0 TO 3
  2.     IF i% < 3 THEN
  3.         FOR ii% = 0 TO 9
  4.             READ resultPieces$(i%, ii%)
  5.         NEXT ii%
  6.     ELSE
  7.         FOR ii% = 0 TO 3
  8.             READ resultPieces$(i%, ii%)
  9.         NEXT ii%
  10.     END IF
  11. NEXT i%
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 29, 2020, 01:36:35 am
Couldn't sit on class today at Terrie's, this code was coming back to me, so we struggled each other a bit more for today

V 1.1 includes:
-set as a function
-array to avoid the CASE SELECT...END SELECT stataments (man... those were really awfull)
-smaller window
-title
-instructions are shown in the program
-no INKEY$ or _LIMIT used, tooked the "zero exit option"
-program warns if conversion can't be made
-sucesful conversion on green, unsuccesfull on red
-goodbye message

Code: QB64: [Select]
  1. '--------------* Setup *--------------
  2. 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"
  3.  
  4. DIM SHARED resultPieces$(3, 9)
  5.  
  6. FOR i% = 0 TO 3
  7.     IF i% < 3 THEN
  8.         FOR ii% = 0 TO 9
  9.             READ resultPieces$(i%, ii%)
  10.         NEXT ii%
  11.     ELSE
  12.         FOR ii% = 0 TO 3
  13.             READ resultPieces$(i%, ii%)
  14.         NEXT ii%
  15.     END IF
  16. NEXT i%
  17.  
  18. SCREEN _NEWIMAGE(250, 96, 32)
  19.  
  20. _TITLE "Arabic to Roman Converter"
  21.  
  22. CONST RED = _RGB32(255, 0, 0)
  23. CONST WHITE = _RGB32(255, 255, 255)
  24. CONST GREEN = _RGB32(0, 255, 0)
  25.  
  26. LOCATE 4, 1
  27.  
  28. '--------------* Program *--------------
  29.     COLOR WHITE
  30.     PRINT "Give me a number from 1 to 3999"
  31.     PRINT "      Enter 0 to leave"
  32.     INPUT "          > ", num%
  33.     CLS
  34.     PRINT num%; "= "; turnIntegerToRoman$(num%)
  35.     PRINT
  36. LOOP UNTIL num% = 0
  37. sayGoodbye
  38.  
  39. '--------------* Functions *--------------
  40. FUNCTION turnIntegerToRoman$ (inputNumber%)
  41.  
  42.     numberAsString$ = LTRIM$(STR$(inputNumber%))
  43.     IF inputNumber% > 0 AND inputNumber% < 4000 THEN
  44.         digits% = LEN(numberAsString$)
  45.         REDIM tmpArray%(digits%)
  46.         REDIM subResult$(digits%)
  47.         FOR i% = 0 TO digits% - 1
  48.             tmpArray%(i%) = VAL(MID$(numberAsString$, digits% - i%, 1))
  49.             subResult$(i%) = resultPieces$(i%, tmpArray%(i%))
  50.             result$ = subResult$(i%) + result$
  51.         NEXT i%
  52.         COLOR GREEN
  53.         turnIntegerToRoman$ = result$
  54.     ELSE
  55.         COLOR RED
  56.         turnIntegerToRoman$ = "I can't convert " + numberAsString$
  57.     END IF
  58.  
  59.  
  60. '--------------* Subroutines *--------------
  61. SUB sayGoodbye ()
  62.  
  63.     CLS
  64.     COLOR RED
  65.     LOCATE 3, 7
  66.     PRINT CHR$(3)
  67.     LOCATE 3, 26
  68.     PRINT CHR$(3)
  69.     COLOR GREEN
  70.     LOCATE 3, 9
  71.     PRINT "Have a nice day!"
  72.  

I really had a lot of fun doing this! =) Any other suggestions? I tried to set the DATA inside the function but didnt worked for a second request, and collapse came (first one works). Any way to improve this?

'------------* EDIT *-----------
forgotten feature: IT'S IN ENGLISH! XD
Title: Re: Decimal to roman numbers converter
Post by: SierraKen on August 29, 2020, 02:05:22 pm
READ can only be used once on the DATA unless you also use the RESTORE <name> command. Here is an example, let's say I want to have data for every day of the week, and want to use it a second time. <name> is a name you want to use right before the DATA lines, like in my example below I use weekdays. Copy/Paste my code below to QB64 so you can see what it does and learn by it. DATA can also use numbers for variables, like READ A and then in the DATA lines it could be: DATA 1,2,3,4,5  without the quotation marks.

Code: QB64: [Select]
  1. FOR weeks = 1 to 2
  2. FOR days = 1 to 7
  3. READ day$
  4. PRINT day$
  5. NEXT days
  6. RESTORE weekdays
  7. NEXT weeks
  8. weekdays:
  9. DATA "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"
  10.  


Title: Re: Decimal to roman numbers converter
Post by: bplus on August 29, 2020, 02:58:38 pm
Hey @Juan Tamarit

You got me curious. Roman to Decimal very doable.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 29, 2020, 06:13:36 pm
Nice! Reversing the program with INSTR ? I WANNA SEE THAT CODE! XD

We should get them togheter, make two separate functions, and a starting menu to select mode: arabic>roman OR roman>arabic

INKEY$ could get on the spotlight at that point...

We should also do some cheking is case user miss-spell the roman number on the string variable you gettin. Things like IC or MIMX

SierraKen: when you say <name> you mean something like a <label>, like in a GOTO ?

Nice to meet you guys! You are cool people! =)
Title: Re: Decimal to roman numbers converter
Post by: bplus on August 29, 2020, 07:14:39 pm
Quote
We should also do some cheking is case user miss-spell the roman number on the string variable you gettin. Things like IC or MIMX

Yes the way my converter code works with 0 checking, you can get 3999 like this IMMMM or I before any of the M because whenever it finds a lesser letter value before a greater (going left to right) that value will be subtracted to total.  You could do this for 344 = IVLCDM (I just checked) ;(

We could maybe do rebuses with this kind of math and letters! LIVID = 553

Title: Re: Decimal to roman numbers converter
Post by: SierraKen on August 29, 2020, 08:41:48 pm
Juan yes, just a label like GOTO. You can see it in my example. :)
Title: Re: Decimal to roman numbers converter
Post by: bplus on August 30, 2020, 12:11:29 am
Update:

By far and away the hardest part of this whole deal is checking the Roman Numeral strings for the proper order of letters. I whipped through my own version of converting decimals to Roman then spent rest of night checking. One last run through check tomorrow with fresh eyes and I will post code for comparisons.
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 30, 2020, 12:36:28 am
I was thinkg in cheking with INST using the DATA on backwars as searchString$

First look for MMM, if not find look for MM, if not find look for M, if not find look for <null>, look for CM, if not found look for DCCC... iterate

Right now im working on the menu and INKEY$ stuff. I'm a bit newbie on this one but im experimenting, soon i'll find the answer

Back to the DATA thing: can the data be cleared from RAM by some order? I think that a good function should load the data, use it and send the answer, and then leave the data occupied free for other things that may be happening

Title: Re: Decimal to roman numbers converter
Post by: Cobalt on August 30, 2020, 01:17:16 am
Back to the DATA thing: can the data be cleared from RAM by some order? I think that a good function should load the data, use it and send the answer, and then leave the data occupied free for other things that may be happening

Well if you are loading the data into an array you could just ERASE array. then you have to RESTORE the data to read it again.

DIM SHARED ROMANNUMERALS(27)
MyData:
Data M,MM,MMM,MMMM,C,L,D,X,V,I,blah,blah,blah
'load the data into the ROMANNUMERALS array
'use it
ERASE ROMANNUMERALS
RESTORE MyData

That would allow you to reload the data over and over.
Though If you load it into an array just reuse the array. no need to clear it out to be reloaded again. Lets face it this program is not sucking up the memory like a vampire(one hopes). So no need to worry about it.
Title: Re: Decimal to roman numbers converter
Post by: Richard Frost on August 30, 2020, 02:27:18 am
A single page table of Roman numerals for decoding movie copyrite years.

Code: QB64: [Select]
  1. DEFINT A-Z
  2. DIM er$(30), ev(30)
  3. FOR i = 1 TO 29
  4.     READ ev(i), er$(i)
  5. r = 1: c = 1
  6. FOR d = 1920 TO 2039
  7.     d$ = LTRIM$(STR$(d))
  8.     t$ = ""
  9.     FOR i = 1 TO LEN(d$)
  10.         c$ = MID$(d$, i, 1)
  11.         t = VAL(c$) * (10 ^ (LEN(d$) - i))
  12.         FOR j = 1 TO 29
  13.             IF ev(j) = t THEN t$ = t$ + er$(j)
  14.         NEXT j
  15.     NEXT i
  16.     LOCATE r, c: PRINT d$; " "; t$;
  17.     r = r + 1
  18.     IF r > 24 THEN
  19.         r = 1
  20.         c = c + 16
  21.     END IF
  22.  
  23. table:
  24. DATA 1,I
  25. DATA 2,II
  26. DATA 3,III
  27. DATA 4,IV
  28. DATA 5,V
  29. DATA 6,VI
  30. DATA 7,VII
  31. DATA 8,IIX
  32. DATA 9,IX
  33. DATA 10,X
  34. DATA 20,XX
  35. DATA 30,XXX
  36. DATA 40,XL
  37. DATA 50,L
  38. DATA 60,LX
  39. DATA 70,LXX
  40. DATA 80,XXC
  41. DATA 90,XC
  42. DATA 100,C
  43. DATA 200,CC
  44. DATA 300,CCC
  45. DATA 400,CD
  46. DATA 500,D
  47. DATA 600,DC
  48. DATA 700,DCC
  49. DATA 800,CCM
  50. DATA 900,CM
  51. DATA 1000,M
  52. DATA 2000,MM
  53.  
Title: Re: Decimal to roman numbers converter
Post by: SMcNeill on August 30, 2020, 03:36:40 am
Here's my little go at this conversion process:

Code: QB64: [Select]
  1. DIM Symbols(1 TO 3) AS STRING, Values(0 TO 3999) AS STRING
  2. Symbols(1) = "IXCM" 'Symbols is a string array to hold the symbols of our roman numerals
  3. Symbols(2) = "VLD "
  4. Symbols(3) = "XCM "
  5.  
  6. FOR I = 0 TO 3999 'here, we build our roman numerals from 0 to 3999 and store them in an array.
  7.     t$ = _TRIM$(STR$(I))
  8.     FOR k = 1 TO LEN(t$)
  9.         t = ASC(t$, k) - 48: j = LEN(t$) - k + 1
  10.         d$ = ""
  11.         SELECT EVERYCASE t
  12.             CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
  13.             CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)
  14.             CASE 3: d$ = d$ + MID$(Symbols(1), j, 1)
  15.             CASE 4 TO 8: d$ = d$ + MID$(Symbols(2), j, 1)
  16.             CASE 6 TO 9: d$ = d$ + MID$(Symbols(1), j, 1)
  17.             CASE 7 TO 8: d$ = d$ + MID$(Symbols(1), j, 1)
  18.             CASE 8: d$ = d$ + MID$(Symbols(1), j, 1)
  19.             CASE 9: d$ = d$ + MID$(Symbols(3), j, 1)
  20.         END SELECT
  21.         Values(I) = Values(I) + d$
  22.     NEXT
  23.  
  24. l = 1: PRINT " = ";
  25. DO 'here we use a custom input routine to get the users value and show its conversion
  26.     t$ = INPUT$(1)
  27.     SELECT CASE t$
  28.         CASE "0" TO "9": v$ = v$ + t$
  29.         CASE CHR$(27): SYSTEM
  30.         CASE CHR$(8): v$ = LEFT$(v$, LEN(v$) - 1)
  31.         CASE CHR$(13): l = l + 1: v$ = "": IF l > _HEIGHT - 1 THEN PRINT: l = _HEIGHT - 1
  32.     END SELECT
  33.     LOCATE l, 1: PRINT "                                           ";
  34.     LOCATE l, 1: PRINT v$; " = ";
  35.     v = VAL(v$)
  36.     IF v < 4000 THEN
  37.         PRINT Values(v);
  38.     ELSE
  39.         PRINT "Invalid value for this program.";
  40.     END IF
  41.     _DISPLAY
  42.  

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.  ;)
Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1.             CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
  2.             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]
  1. _TITLE "Roman2Decimal Test, enter nothing will quit test loop, there are 3 test loops." ' B+ 2020-08-29
  2. ' 2020-08-29 how to go the other way? Decimal2Roman$
  3. ' RomanProper$ confirms a proper Roman Numeral with Y for Yes else error message.
  4.  
  5.     PRINT "                 *** Testing the RomanProper$ function ***"
  6.     PRINT "    Please enter a funky Roman Numeral to see if we can catch what is wrong,"
  7.     PRINT "        or enter a good one and see if we can catch it being right :)"
  8.     PRINT
  9.     INPUT " Enter test: "; test$
  10.     IF test$ = "" THEN EXIT DO
  11.     returned$ = RomanProper$(test$)
  12.     IF returned$ = "Y" THEN
  13.         PRINT "        The RomanProper$ function detected no erors for "; test$
  14.     ELSE
  15.         PRINT SPACE$(5) + returned$
  16.     END IF
  17.     PRINT
  18.  
  19.     PRINT "       *** Testing the Decimal2Roman$ function ***"
  20.     INPUT " Enter a number (1 to 3999) to convert to Roman Numerals "; test
  21.     IF test = 0 THEN EXIT DO
  22.     convert$ = Decimal2Roman$(test)
  23.     PRINT "The converter says that should be: "; convert$
  24.     PRINT
  25.  
  26.     PRINT "            *** Testing the Roman2Decimal% function ***"
  27.     PRINT " Enter a number (1 to 3999) in Roman Numerals to test proper conversion: "
  28.     PRINT
  29.     INPUT " Enter test string "; test$
  30.     IF test$ = "" THEN EXIT DO
  31.     convert = Roman2Decimal%(test$)
  32.     PRINT "The converter says that was: "; convert
  33.     PRINT
  34.  
  35. FUNCTION Roman2Decimal% (rS$) 'Caution: no checks for Roman syntax
  36.     STATIC Roman$, rV(1 TO 7) AS INTEGER
  37.     IF rV(7) <> 1000 THEN 'do once and for all time
  38.         Roman$ = "IVXLCDM"
  39.         FOR i = 1 TO 7
  40.             IF i MOD 2 = 0 THEN rV(i) = 5 * 10 ^ (i / 2 - 1) ELSE rV(i) = 10 ^ ((i - 1) / 2)
  41.         NEXT
  42.     END IF
  43.     'now for the current call
  44.     FOR i = 1 TO LEN(rS$)
  45.         lv = rV(INSTR(Roman$, MID$(rS$, i, 1)))
  46.         IF i <> LEN(rS$) THEN
  47.             lv2 = rV(INSTR(Roman$, MID$(rS$, i + 1, 1)))
  48.             IF lv2 > lv THEN lv = -lv
  49.         END IF
  50.         convert = convert + lv
  51.     NEXT
  52.     Roman2Decimal% = convert
  53.  
  54. FUNCTION Decimal2Roman$ (d AS INTEGER) ' 1 to 3999
  55.     cd = d 'make copy because changing
  56.     STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10)
  57.     IF Ones$(10) = "" THEN 'setup our arrays
  58.         Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
  59.         Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
  60.         FOR i = 1 TO 10
  61.             Tens$(i) = strReplace$(Ones$(i), "X", "C")
  62.             Tens$(i) = strReplace$(Tens$(i), "I", "X")
  63.             Tens$(i) = strReplace$(Tens$(i), "V", "L")
  64.             H100s$(i) = strReplace$(Ones$(i), "X", "M")
  65.             H100s$(i) = strReplace$(H100s$(i), "I", "C")
  66.             H100s$(i) = strReplace$(H100s$(i), "V", "D")
  67.         NEXT
  68.     END IF
  69.     IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M"): cd = cd - 1000 * INT(cd / 1000)
  70.     IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100)): cd = cd - 100 * INT(cd / 100)
  71.     IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10)): cd = cd - 10 * INT(cd / 10)
  72.     IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
  73.     Decimal2Roman$ = convert$
  74.  
  75. FUNCTION strReplace$ (s$, replace$, new$) 'case sensitive  2020-07-28 version
  76.     DIM p AS LONG, sCopy$, LR AS INTEGER, lNew AS INTEGER
  77.     IF LEN(s$) = 0 OR LEN(replace$) = 0 THEN
  78.         strReplace$ = s$: EXIT FUNCTION
  79.     ELSE
  80.         LR = LEN(replace$): lNew = LEN(new$)
  81.     END IF
  82.  
  83.     sCopy$ = s$ ' otherwise s$ would get changed
  84.     p = INSTR(sCopy$, replace$)
  85.     WHILE p
  86.         sCopy$ = MID$(sCopy$, 1, p - 1) + new$ + MID$(sCopy$, p + LR)
  87.         p = INSTR(p + lNew, sCopy$, replace$)
  88.     WEND
  89.     strReplace$ = sCopy$
  90.  
  91. FUNCTION RomanProper$ (test$) ' is test$ a Roman Numeral with proper syntax? Y for Yes, if No then error message.
  92.     test$ = _TRIM$(UCASE$(test$)) ' it should be OK to make this change to the argument in not in Capitals
  93.     Roman$ = "MDCLXVI": checked$ = SPACE$(7) ' 2, 4, 6 should only appear once the others up to 3 except M 4 max
  94.     FOR i = 1 TO LEN(test$)
  95.         L$ = MID$(test$, i, 1)
  96.         p = INSTR(Roman$, L$)
  97.         IF i <> LEN(test$) THEN nextL$ = MID$(test$, i + 1, 1) ELSE nextL$ = ""
  98.  
  99.         IF p = 0 THEN RomanProper$ = "Error: wrong character in string.": EXIT SUB
  100.         IF p MOD 2 = 0 THEN
  101.             IF L$ = "V" THEN
  102.                 IF nextL$ <> "" AND nextL$ <> "I" THEN RomanProper$ = "Error: out of order.": EXIT SUB
  103.             ELSEIF L$ = "L" THEN
  104.                 IF nextL$ <> "" AND nextL$ <> "I" AND nextL$ <> "V" AND nextL$ <> "X" THEN RomanProper$ = "Error: out of order.": EXIT SUB
  105.                 IF lastL$ = "I" THEN RomanProper$ = "Error: out of order.": EXIT SUB
  106.             ELSEIF L$ = "D" THEN
  107.                 IF nextL$ = "M" THEN RomanProper$ = "Error: out of order.": EXIT SUB
  108.                 IF lastp > p AND lastL$ <> "C" THEN RomanProper$ = "Error: out of order.": EXIT SUB
  109.             END IF
  110.             IF MID$(checked$, p, 1) = " " THEN
  111.                 MID$(checked$, p, 1) = "1"
  112.             ELSE
  113.                 RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
  114.             END IF
  115.         ELSE ' p mod 2 = 1
  116.             vM = VAL(MID$(checked$, p, 1))
  117.             IF L$ = "M" THEN
  118.                 IF (lastL$ <> "M" AND lastL$ <> "C") AND lastL$ <> "" THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
  119.                 IF vM > 3 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
  120.                 MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
  121.             ELSEIF L$ = "C" THEN
  122.                 IF lastL$ = "L" OR lastL$ = "V" OR lastL$ = "I" THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
  123.                 IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
  124.                 MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
  125.             ELSEIF L$ = "X" THEN
  126.                 IF MID$(checked$, 6, 1) = "1" OR VAL(MID$(checked$, 7, 1)) > 1 THEN RomanProper$ = "Error: " + L$ + " out of order.": EXIT SUB
  127.                 IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
  128.                 MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
  129.             ELSEIF L$ = "I" THEN 'can follow any letter
  130.                 IF vM > 2 THEN RomanProper$ = "Error: too many " + L$ + "'s.": EXIT SUB
  131.                 MID$(checked$, p, 1) = _TRIM$(STR$(vM + 1))
  132.             END IF
  133.         END IF
  134.         lastp = p
  135.         lastL$ = L$
  136.     NEXT
  137.     'still here?
  138.     RomanProper$ = "Y" 'then must be OK
  139.  
  140.  
  141.  

Just to see, I will rewrite this with Steve's idea for check of RomanProper$ and a more straightforward way for decimal2Roman$.
Title: Re: Decimal to roman numbers converter
Post by: SMcNeill 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

Title: Re: Decimal to roman numbers converter
Post by: bplus on August 30, 2020, 01:12:28 pm
@SMcNeill That's very cool pattern recognition!

And what a great demo of EVERYCASE!
Title: Re: Decimal to roman numbers converter
Post by: SMcNeill 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]
  1. DIM Symbols(1 TO 3) AS STRING, Values(0 TO 3999) AS STRING
  2. Symbols(1) = "IXCM" 'Symbols is a string array to hold the symbols of our roman numerals
  3. Symbols(2) = "VLD "
  4. Symbols(3) = "XCM "
  5.  
  6. FOR I = 0 TO 3999 'here, we build our roman numerals from 0 to 3999 and store them in an array.
  7.     t$ = _TRIM$(STR$(I))
  8.     FOR k = 1 TO LEN(t$)
  9.         t = ASC(t$, k) - 48: j = LEN(t$) - k + 1
  10.         d$ = ""
  11.         SELECT EVERYCASE t
  12.             CASE 1 TO 4: d$ = d$ + MID$(Symbols(1), j, 1)
  13.             CASE 2 TO 3: d$ = d$ + MID$(Symbols(1), j, 1)
  14.             CASE 3: d$ = d$ + MID$(Symbols(1), j, 1)
  15.             CASE 4 TO 8: d$ = d$ + MID$(Symbols(2), j, 1)
  16.             CASE 6 TO 9: d$ = d$ + MID$(Symbols(1), j, 1)
  17.             CASE 7 TO 8: d$ = d$ + MID$(Symbols(1), j, 1)
  18.             CASE 8: d$ = d$ + MID$(Symbols(1), j, 1)
  19.             CASE 9: d$ = d$ + MID$(Symbols(3), j, 1)
  20.         END SELECT
  21.         Values(I) = Values(I) + d$
  22.     NEXT
  23.  
  24. l = 1: PRINT " = ";
  25. DO 'here we use a custom input routine to get the users value and show its conversion
  26.     t$ = INPUT$(1)
  27.     SELECT CASE UCASE$(t$)
  28.         CASE "0" TO "9", "I", "X", "V", "C", "D", "L", "M": v$ = v$ + UCASE$(t$)
  29.         CASE CHR$(27): SYSTEM
  30.         CASE CHR$(8): v$ = LEFT$(v$, LEN(v$) - 1)
  31.         CASE CHR$(13): l = l + 1: v$ = "": IF l > _HEIGHT - 1 THEN PRINT: l = _HEIGHT - 1
  32.     END SELECT
  33.     LOCATE l, 1: PRINT "                                           ";
  34.     LOCATE l, 1: PRINT v$; " = ";
  35.     v = VAL(v$)
  36.     IF v = 0 THEN
  37.         FOR I = 0 TO 3999
  38.             IF v$ = Values(I) THEN PRINT I;: EXIT FOR
  39.         NEXT
  40.         IF I = 4000 THEN PRINT "Invalid value for this program.";
  41.     ELSEIF v < 4000 THEN
  42.         PRINT Values(v);
  43.     ELSE
  44.         PRINT "Invalid value for this program.";
  45.     END IF
  46.     _DISPLAY
  47.  

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.  ;)
Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1. _TITLE "Roman SUB Test" ' B+ 2020-08-30 rewrite old to one sub, using several hints from SMcNeill
  2.     PRINT " Testing conversion of numbers 1 to 3999 to or from Roman Numerals >"
  3.     INPUT " Enter a string to test "; test$
  4.     Roman test$, return$
  5.     PRINT " The Roman SUB returned: "; return$
  6.     PRINT
  7. LOOP UNTIL test$ = ""
  8.  
  9. SUB Roman (inStr$, outStr$) ' 1 to 3999
  10.     STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10), R$(1 TO 3999)
  11.     IF Ones$(10) = "" THEN 'setup our arrays
  12.         Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
  13.         Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
  14.         Tens$(1) = "X": Tens$(2) = "XX": Tens$(3) = "XXX": Tens$(4) = "XL": Tens$(5) = "L"
  15.         Tens$(6) = "LX": Tens$(7) = "LXX": Tens$(8) = "LXXX": Tens$(9) = "XC": Tens$(10) = "C"
  16.         H100s$(1) = "C": H100s$(2) = "CC": H100s$(3) = "CCC": H100s$(4) = "CD": H100s$(5) = "D"
  17.         H100s$(6) = "DC": H100s$(7) = "DCC": H100s$(8) = "DCCC": H100s$(9) = "CM": H100s$(10) = "M"
  18.         FOR i = 1 TO 3999
  19.             cd = i: convert$ = ""
  20.             IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M"): cd = cd - 1000 * INT(cd / 1000)
  21.             IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100)): cd = cd - 100 * INT(cd / 100)
  22.             IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10)): cd = cd - 10 * INT(cd / 10)
  23.             IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
  24.             R$(i) = convert$
  25.         NEXT
  26.     END IF
  27.     s$ = _TRIM$(UCASE$(inStr$))
  28.     IF s$ = "" OR s$ = "0" THEN outStr$ = "Error: nada": EXIT SUB 'handle nothing
  29.     FOR i = 1 TO LEN(s$)
  30.         pd = INSTR("0123456789", MID$(s$, i, 1)): pr = INSTR("MDCLXVI", MID$(s$, i, 1))
  31.         IF pd = 0 AND pr = 0 THEN outStr$ = "Error: unknown character.": EXIT SUB 'handle wrong alpha
  32.         IF i > 1 THEN 'check for mixed messages
  33.             IF (lastpd = 0 AND pd > 0) OR (lastpr = 0 AND pr > 0) THEN outStr$ = "Error: digits mixed with letters.": EXIT SUB
  34.         END IF
  35.         lastpd = pd: lastpr = pr
  36.     NEXT
  37.     v = VAL(s$)
  38.     IF v = 0 THEN
  39.         FOR i = 1 TO 3999
  40.             IF R$(i) = s$ THEN outStr$ = _TRIM$(STR$(i)): EXIT SUB
  41.         NEXT
  42.         outStr$ = "Error: Invalid Roman Numeral? string."
  43.     ELSEIF v > 0 AND v < 4000 THEN
  44.         outStr$ = R$(v)
  45.     ELSE
  46.         outStr$ = "Error: Not in range of 1 to 3999."
  47.     END IF
  48.  
Title: Re: Decimal to roman numbers converter
Post by: bplus on August 31, 2020, 12:56:28 am
Code: QB64: [Select]
  1.  

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.
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit 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]
  1. '--------------* Setup *--------------
  2. 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"
  3.  
  4. DIM SHARED resultPieces$(3, 9)
  5.  
  6. FOR i% = 0 TO 3
  7.     IF i% < 3 THEN
  8.         FOR ii% = 0 TO 9
  9.             READ resultPieces$(i%, ii%)
  10.         NEXT ii%
  11.     ELSE
  12.         FOR ii% = 0 TO 3
  13.             READ resultPieces$(i%, ii%)
  14.         NEXT ii%
  15.     END IF
  16. NEXT i%
  17.  
  18. SCREEN _NEWIMAGE(250, 96, 32)
  19. CONST WHITE = _RGB32(255, 255, 255)
  20. CONST YELLOW = _RGB32(255, 255, 0)
  21. CONST RED = _RGB32(255, 0, 0)
  22. CONST GREEN = _RGB32(0, 255, 0)
  23. CONST LIGHTGRAY = _RGB32(127, 127, 127)
  24. CONST DARKGRAY = _RGB32(63, 63, 63)
  25.  
  26. _TITLE "Arabic/Roman Conversor"
  27.  
  28. DIM actualMenuWorking%
  29. DIM menuHighlight%
  30.  
  31.  
  32. DIM KeyPress$
  33.  
  34. actualMenuWorking% = 0
  35. menuHighlight% = 1
  36.  
  37. '--------------* Program V1.2 *--------------
  38. sayHello
  39.     DO
  40.         KeyPress$ = INKEY$
  41.         _LIMIT 30
  42.         SELECT CASE actualMenuWorking%
  43.             CASE 0: printMainMenu
  44.             CASE 1: arabicToRoman
  45.             CASE 2: romanToArabic
  46.             CASE -1: sayGoodbye
  47.         END SELECT
  48.     LOOP UNTIL KeyPress$ <> ""
  49.  
  50.     IF KeyPress$ = CHR$(13) THEN
  51.         SELECT CASE menuHighlight%
  52.             CASE 1: actualMenuWorking% = 1
  53.             CASE 2: actualMenuWorking% = 2
  54.             CASE 3: actualMenuWorking% = -1
  55.         END SELECT
  56.     ELSEIF KeyPress$ = CHR$(0) + "H" THEN
  57.         IF menuHighlight% <> 1 THEN menuHighlight% = menuHighlight% - 1
  58.     ELSEIF KeyPress$ = CHR$(0) + "P" THEN
  59.         IF menuHighlight% <> 3 THEN menuHighlight% = menuHighlight% + 1
  60.     ELSEIF KeyPress$ = CHR$(27) THEN
  61.         menuHighlight% = 3
  62.     END IF
  63.  
  64.  
  65.  
  66. '--------------* Functions *--------------
  67. FUNCTION turnIntegerToRoman$ (inputNumber%)
  68.  
  69.     numberAsString$ = LTRIM$(STR$(inputNumber%))
  70.     IF inputNumber% > 0 AND inputNumber% < 4000 THEN
  71.         digits% = LEN(numberAsString$)
  72.         REDIM tmpArray%(digits%)
  73.         REDIM subResult$(digits%)
  74.         FOR i% = 0 TO digits% - 1
  75.             tmpArray%(i%) = VAL(MID$(numberAsString$, digits% - i%, 1))
  76.             subResult$(i%) = resultPieces$(i%, tmpArray%(i%))
  77.             result$ = subResult$(i%) + result$
  78.         NEXT i%
  79.         COLOR GREEN
  80.         turnIntegerToRoman$ = result$
  81.     ELSE
  82.         COLOR RED
  83.         turnIntegerToRoman$ = "I can't convert " + numberAsString$
  84.     END IF
  85.  
  86.  
  87. '- - - - - - - - - - - - - - - - - - - - - -
  88. FUNCTION turnRomanToInteger$ (inputRoman$) ' in process
  89.  
  90.     DIM subResult$
  91.     subResult$ = ""
  92.  
  93.     FOR i% = 3 TO 0 STEP -1
  94.         IF i% = 3 THEN
  95.             FOR ii% = 3 TO 0 STEP -1
  96.                 IF INSTR(inputRoman$, resultPieces$(i%, ii%)) THEN
  97.                     subResult$ = subResult$ + LTRIM$(STR$(ii%))
  98.                     EXIT FOR
  99.                 END IF
  100.             NEXT ii%
  101.         ELSE
  102.             FOR ii% = 9 TO 0 STEP -1
  103.                 IF INSTR(inputRoman$, resultPieces$(i%, ii%)) THEN
  104.                     subResult$ = subResult$ + LTRIM$(STR$(ii%))
  105.                     EXIT FOR
  106.                 END IF
  107.             NEXT ii%
  108.         END IF
  109.     NEXT i%
  110.  
  111.     IF subResult$ <> "" THEN
  112.         COLOR GREEN
  113.         turnRomanToInteger$ = subResult$
  114.     ELSE
  115.         COLOR RED
  116.         turnRomanToInteger$ = "Not a roman!"
  117.     END IF
  118.  
  119.  
  120. '--------------* Subroutines *--------------
  121. SUB sayHello ()
  122.  
  123.     helloMessage1$ = "         Hello master"
  124.     helloMessage2$ = "  Order me and i will obey..."
  125.  
  126.     COLOR GREEN
  127.  
  128.     i% = 0
  129.     DO
  130.         _DELAY .05
  131.         i% = i% + 1
  132.         buildingMessage$ = LEFT$(helloMessage1$, i%) + CHR$(219)
  133.         LOCATE 3, 1
  134.         PRINT buildingMessage$
  135.     LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage1$) + 1
  136.     LOCATE CSRLIN - 1, LEN(helloMessage1$) + 1: PRINT " "
  137.  
  138.     i% = 0
  139.     DO
  140.         _DELAY .05
  141.         i% = i% + 1
  142.         buildingMessage$ = LEFT$(helloMessage2$, i%) + CHR$(219)
  143.         LOCATE 4, 1
  144.         PRINT buildingMessage$
  145.     LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage2$) + 1
  146.     LOCATE CSRLIN - 1, LEN(helloMessage2$) + 1: PRINT " "
  147.  
  148.     SLEEP 2
  149.     CLS
  150.  
  151.  
  152. '- - - - - - - - - - - - - - - - - - - - - -
  153. SUB printMainMenu ()
  154.  
  155.     SHARED menuHighlight%
  156.  
  157.     CLS
  158.  
  159.     LOCATE 1, 1
  160.     COLOR WHITE
  161.     PRINT "     Roman/Arabic Conversor";
  162.     LOCATE 2, 1
  163.     PRINT SPACE$(5);: PRINT STRING$(22, CHR$(223));
  164.  
  165.     IF menuHighlight% = 1 THEN
  166.         COLOR YELLOW
  167.         LOCATE 3, 7
  168.         PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27);
  169.     ELSE
  170.         COLOR DARKGRAY
  171.     END IF
  172.     LOCATE 3, 9
  173.     PRINT "Arabic  Roman";
  174.  
  175.     IF menuHighlight% = 2 THEN
  176.         COLOR YELLOW
  177.         LOCATE 4, 7
  178.         PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27);
  179.     ELSE
  180.         COLOR DARKGRAY
  181.     END IF
  182.     LOCATE 4, 9
  183.     PRINT "Roman  Arabic";
  184.  
  185.     IF menuHighlight% = 3 THEN
  186.         COLOR YELLOW
  187.         LOCATE 5, 12
  188.         PRINT CHR$(26);: PRINT SPACE$(6);: PRINT CHR$(27);
  189.     ELSE
  190.         COLOR DARKGRAY
  191.     END IF
  192.     LOCATE 5, 14
  193.     PRINT "Exit";
  194.  
  195.     COLOR WHITE
  196.     LOCATE 6, 1
  197.     PRINT " UP-DOWN select / ENTER choose";
  198.  
  199.     _DISPLAY
  200.  
  201.  
  202. '- - - - - - - - - - - - - - - - - - - - - -
  203. SUB arabicToRoman ()
  204.  
  205.     SHARED actualMenuWorking%
  206.  
  207.     subInput$ = ""
  208.     num% = 0
  209.  
  210.     DO
  211.         DO
  212.             CLS
  213.             COLOR WHITE
  214.             LOCATE 1, 1
  215.             PRINT "Give me a number from 1 to 3999"
  216.             PRINT "     Press ESC to go back"
  217.             PRINT "          > ";: PRINT subInput$ + CHR$(95)
  218.             PRINT
  219.             PRINT num%; "= "; turnIntegerToRoman$(num%);
  220.             KeyPress$ = INKEY$
  221.             _LIMIT 40
  222.             _DISPLAY
  223.         LOOP UNTIL KeyPress$ <> ""
  224.  
  225.         'NUMBERS
  226.         IF (ASC(KeyPress$) > 47 AND ASC(KeyPress$) < 58) THEN 'if NUMBER pressed and the subInput$ is not longer
  227.             IF LEN(subInput$) < 4 THEN subInput$ = subInput$ + KeyPress$ '    than 4 then increase the subInput$
  228.  
  229.             'BACKSPACE
  230.         ELSEIF KeyPress$ = CHR$(8) THEN '                   if BACKSPACE pressed and subInput ain't null
  231.             IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
  232.  
  233.             ' ENTER
  234.         ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
  235.             IF subInput$ <> "" THEN '       subInput$ ain't null then
  236.                 num% = VAL(subInput$) '     turn to a value and save it to num%
  237.                 subInput$ = "" '            and clear subInput$
  238.             END IF
  239.         END IF
  240.  
  241.         'ESC
  242.     LOOP UNTIL KeyPress$ = CHR$(27)
  243.     actualMenuWorking% = 0
  244.  
  245.  
  246. '- - - - - - - - - - - - - - - - - - - - - -
  247. SUB romanToArabic ()
  248.  
  249.     SHARED actualMenuWorking%
  250.  
  251.     subInput$ = ""
  252.     lastInput$ = "I"
  253.  
  254.     DO
  255.         DO
  256.             CLS
  257.             COLOR WHITE
  258.             LOCATE 1, 1
  259.             PRINT "Give me a number from 1 to 3999"
  260.             PRINT "     Press ESC to go back"
  261.             PRINT "      > ";: PRINT subInput$ + CHR$(95)
  262.             PRINT
  263.             PRINT " "; lastInput$; "= "; turnRomanToInteger$(lastInput$);
  264.             KeyPress$ = INKEY$
  265.             _LIMIT 40
  266.             _DISPLAY
  267.         LOOP UNTIL KeyPress$ <> ""
  268.  
  269.         'LETTERS
  270.         IF LEN(subInput$) < 15 THEN ' if roman not longer than 15 (MMMDCCCLXXXVIII)
  271.             SELECT CASE ASC(KeyPress$) ' only valid letters
  272.                 CASE 73 OR 105: subInput$ = subInput$ + KeyPress$ ' I
  273.                 CASE 86 OR 118: subInput$ = subInput$ + KeyPress$ ' V
  274.                 CASE 88 OR 120: subInput$ = subInput$ + KeyPress$ ' X
  275.                 CASE 76 OR 108: subInput$ = subInput$ + KeyPress$ ' L
  276.                 CASE 67 OR 99: subInput$ = subInput$ + KeyPress$ '  C
  277.                 CASE 68 OR 100: subInput$ = subInput$ + KeyPress$ ' D
  278.                 CASE 77 OR 109: subInput$ = subInput$ + KeyPress$ ' M
  279.             END SELECT
  280.         END IF
  281.  
  282.         'BACKSPACE
  283.         IF KeyPress$ = CHR$(8) THEN ' if BACKSPACE pressen and subInput ain't null
  284.             IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
  285.  
  286.             ' ENTER
  287.         ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
  288.             IF subInput$ <> "" THEN '       subInput$ ain't null then
  289.                 lastInput$ = subInput$ '    do as user says
  290.                 subInput$ = "" '            and clear subInput$
  291.             END IF
  292.         END IF
  293.  
  294.         subInput$ = UCASE$(subInput$) ' in case user dosn't use uppers
  295.  
  296.         'ESC
  297.     LOOP UNTIL KeyPress$ = CHR$(27)
  298.     actualMenuWorking% = 0
  299.  
  300.  
  301. '- - - - - - - - - - - - - - - - - - - - - -
  302. SUB sayGoodbye ()
  303.  
  304.     CLS
  305.  
  306.     goodbyeMessage$ = "Have a nice day!"
  307.  
  308.     COLOR RED
  309.     LOCATE 3, 7
  310.     PRINT CHR$(3)
  311.     LOCATE 3, 26
  312.     PRINT CHR$(3)
  313.  
  314.     COLOR GREEN
  315.     i% = 0
  316.     DO
  317.         _DELAY .05
  318.         i% = i% + 1
  319.         buildingMessage$ = LEFT$(goodbyeMessage$, i%)
  320.         LOCATE 3, 9
  321.         PRINT buildingMessage$
  322.         _DISPLAY
  323.     LOOP UNTIL LEN(buildingMessage$) = LEN(goodbyeMessage$)
  324.  
  325.     SLEEP 2
  326.     SYSTEM
  327.  
  328.  
  329.  

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!
Title: Re: Decimal to roman numbers converter
Post by: bplus 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.
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit 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!
Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1. _TITLE "Roman SUB Test" ' B+ 2020-08-30 rewrite old to one sub, using several hints from SMcNeill
  2.  
  3.  
  4. 'I hope you can understand how this testing part works :)
  5.     PRINT " Testing conversion of numbers 1 to 3999 to or from Roman Numerals >"
  6.     INPUT " Enter a string to test "; test$
  7.  
  8.     'Here is the crucial call to the SUB we are testing.
  9.     Roman test$, RETURN$
  10.     PRINT " The Roman SUB returned: "; RETURN$
  11.     PRINT
  12. LOOP UNTIL test$ = ""
  13.  
  14.  
  15.  
  16. SUB Roman (inStr$, outStr$) ' 1 to 3999  The inStr$ variable brings in a decimal or a Roman Numeral
  17.     '                         and Roman SUB will output the conversion or an Error: message in outStr$.
  18.  
  19.     STATIC Ones$(1 TO 10), Tens$(1 TO 10), H100s$(1 TO 10), R$(1 TO 3999)
  20.     'STATIC preserves all values between calls to the SUB procedure.
  21.  
  22.  
  23.     IF Ones$(10) = "" THEN 'setup our arrays
  24.         'If Ones$(10) = "" then this is very first time this sub is called, so load up the arrays of data.
  25.  
  26.         'directly load data into the arrays without READ and DATA statements
  27.         Ones$(1) = "I": Ones$(2) = "II": Ones$(3) = "III": Ones$(4) = "IV": Ones$(5) = "V"
  28.         Ones$(6) = "VI": Ones$(7) = "VII": Ones$(8) = "VIII": Ones$(9) = "IX": Ones$(10) = "X"
  29.         Tens$(1) = "X": Tens$(2) = "XX": Tens$(3) = "XXX": Tens$(4) = "XL": Tens$(5) = "L"
  30.         Tens$(6) = "LX": Tens$(7) = "LXX": Tens$(8) = "LXXX": Tens$(9) = "XC": Tens$(10) = "C"
  31.         H100s$(1) = "C": H100s$(2) = "CC": H100s$(3) = "CCC": H100s$(4) = "CD": H100s$(5) = "D"
  32.         H100s$(6) = "DC": H100s$(7) = "DCC": H100s$(8) = "DCCC": H100s$(9) = "CM": H100s$(10) = "M"
  33.  
  34.  
  35.         'R is for Roman, the R$() array will hold all the Roman Numeral Strings from 1 to 3999.
  36.         FOR i = 1 TO 3999
  37.  
  38.             cd = i 'cd originally stood for copy decimal from original Decimal2Roman function,
  39.             '       here I just kept the name for decimal numbers.
  40.  
  41.             convert$ = "" ' I am converting the decimal number to Roman,
  42.             '               this variable is storing the building of the Roman string.
  43.  
  44.             'Building from decimal 1000's:
  45.             ' INT(cd / 1000) is how many 1000's the number cd has.
  46.             ' The STRING$ function creates repeated characters, so repeating M the number of 1000's I have.
  47.             IF cd > 1000 THEN convert$ = STRING$(INT(cd / 1000), "M")
  48.  
  49.             'Take away 1000's in build, whats left is back in cd.
  50.             cd = cd - 1000 * INT(cd / 1000)
  51.  
  52.  
  53.             'Now how many 100's do I have?  This many = INT(cd / 100). Lookup that number in h100s$() symbols.
  54.             'If it was 5 then h100s$(5) = "D", add that to my build variable convert$.
  55.             IF cd > 100 THEN convert$ = convert$ + H100s$(INT(cd / 100))
  56.  
  57.             'And sutract my 100's from cd.
  58.             cd = cd - 100 * INT(cd / 100)
  59.  
  60.             'Now how many 10's do I have?  This many = INT(cd / 10), use that number for index to Tens$() lookup symbol.
  61.             'and add it to convert$.
  62.             IF cd > 10 THEN convert$ = convert$ + Tens$(INT(cd / 10))
  63.  
  64.             'And subtract 10's from cd.
  65.             cd = cd - 10 * INT(cd / 10)
  66.  
  67.             'And finally for ones place of decimal number cd is all that remains lookup the symbol in Ones$()
  68.             'and add it to convert$.
  69.             IF cd >= 1 THEN convert$ = convert$ + Ones$(cd)
  70.  
  71.             'OK the Roman Numeral string is built in the variable convert$, save it in our big R$() array.
  72.             R$(i) = convert$
  73.         NEXT
  74.  
  75.         'we are now done with all setup and ready to start converting number by array lookups
  76.     END IF
  77.  
  78.  
  79.  
  80.     'Make a copy of instr$ it could be decimal or it could be Roman we don't know yet,
  81.     ' but we want to make sure spaces are trimmed and any letters are capitalized.
  82.     's is for string!
  83.     s$ = _TRIM$(UCASE$(inStr$))
  84.  
  85.     ' Let's get rid of trivial error cases first.
  86.     IF s$ = "" OR s$ = "0" THEN outStr$ = "Error: nada": EXIT SUB 'handle nothing
  87.  
  88.     ' Now is inStr$ all decimal digits or all Roman Letters or something that indicates an error?
  89.     FOR i = 1 TO LEN(s$)
  90.  
  91.         '  pd is for place of digit.                pr is for place of Roman Letter.
  92.         pd = INSTR("0123456789", MID$(s$, i, 1)): pr = INSTR("MDCLXVI", MID$(s$, i, 1))
  93.  
  94.         ' If both are 0 then there is a crazy character on the loose, time to bug out!
  95.         IF pd = 0 AND pr = 0 THEN outStr$ = "Error: unknown character.": EXIT SUB 'handle wrong alpha
  96.  
  97.         ' Here we compare the pd to the last pd and pr to the last pr to check for mixed messages.
  98.         ' If the current character is Roman and the last was a decimal then WTH? letters are mixed with digits.
  99.         ' Time to get out of Dodge!
  100.         IF i > 1 THEN 'check for mixed messages
  101.             IF (lastpd = 0 AND pd > 0) OR (lastpr = 0 AND pr > 0) THEN outStr$ = "Error: digits mixed with letters.": EXIT SUB
  102.         END IF
  103.  
  104.         'save for comparing the next characters
  105.         lastpd = pd: lastpr = pr
  106.     NEXT
  107.  
  108.  
  109.     'OK we have checked that all the characters are either all Roman letters OR all decimal digits.
  110.     ' Time to lay our cards on the table and see which is which from VAL function.
  111.     v = VAL(s$)
  112.  
  113.  
  114.     IF v = 0 THEN ' Then it must be that s$ was all letters that have no value to VAL.
  115.         FOR i = 1 TO 3999 ' So run through the table of Roman strings and match it to what we have in s$.
  116.  
  117.             'Aha a match at i = something, then i is the decimal number for that Roman String.
  118.             'Ship it out in the outStr$ variable, trimmed nice and neat of spaces STR$ tends to add to positive numbers.
  119.             IF R$(i) = s$ THEN outStr$ = _TRIM$(STR$(i)): EXIT SUB
  120.         NEXT
  121.  
  122.         'If we are still in this SUB that means we did not find a matching string, so sorry ;(
  123.         outStr$ = "Error: Invalid Roman Numeral? string."
  124.  
  125.     ELSEIF v > 0 AND v < 4000 THEN ' in range of our array
  126.         'Else s$ has been loaded with digits all this time but are the digits in range of our Roman Numbers?
  127.  
  128.  
  129.         ' Yes it is safe to call on index v of R$(), there will be a Roman Numeral ready to ship out in outStr$,
  130.         ' so put it there.
  131.         outStr$ = R$(v)
  132.  
  133.  
  134.     ELSE
  135.         ' We are not in range, so report a complaint ;(
  136.         outStr$ = "Error: Not in range of 1 to 3999."
  137.     END IF
  138.  
  139.  
  140.  

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)
Title: Re: Decimal to roman numbers converter
Post by: TempodiBasic 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 (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 (https://es.wikipedia.org/wiki/Cero)
Good Luck and
enjoy yourself with programming in QBASIC/QB64
Title: Re: Decimal to roman numbers converter
Post by: bplus 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.
Title: Re: Decimal to roman numbers converter
Post by: bplus 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.
Title: Re: Decimal to roman numbers converter
Post by: SMcNeill 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..
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit 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]
  1. '--------------* Setup *--------------
  2. 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"
  3.  
  4. DIM SHARED resultPieces$(3, 9) '       ÍÍÍ»
  5. '                                         º
  6. FOR i% = 0 TO 3 '                         º
  7.     IF i% < 3 THEN '                      º
  8.         FOR ii% = 0 TO 9 '                º load DATA in
  9.             READ resultPieces$(i%, ii%) ' º this array
  10.         NEXT ii% '                        º
  11.     ELSE '                                º
  12.         FOR ii% = 0 TO 3 '                º
  13.             READ resultPieces$(i%, ii%) ' º
  14.         NEXT ii% '                        º
  15.     END IF '                              º
  16. NEXT i% '                              ÍÍͼ
  17.  
  18. SCREEN _NEWIMAGE(250, 96, 32) '        ÍÍÍ»
  19. CONST WHITE = _RGB32(255, 255, 255) '     º
  20. CONST YELLOW = _RGB32(255, 255, 0) '      º
  21. CONST RED = _RGB32(255, 0, 0) '           º set screen size
  22. CONST GREEN = _RGB32(0, 255, 0) '         º and colors
  23. CONST LIGHTGRAY = _RGB32(127, 127, 127) ' º
  24. CONST DARKGRAY = _RGB32(63, 63, 63) '  ÍÍͼ
  25.  
  26. _TITLE "Arabic/Roman Conversor"
  27.  
  28. DIM actualMenuWorking%
  29. DIM menuHighlight%
  30.  
  31.  
  32. DIM KeyPress$ ' key press by user
  33.  
  34. actualMenuWorking% = 0
  35. menuHighlight% = 1
  36.  
  37. '--------------* Program V1.2 *--------------
  38. sayHello
  39.  
  40.     DO '                         ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
  41.         KeyPress$ = INKEY$ '                             º get a key
  42.         _LIMIT 20 '                                      º from user
  43.         SELECT CASE actualMenuWorking% ' Í»              º
  44.             CASE 0: printMainMenu '       º              º
  45.             CASE 1: arabicToRoman '       º what do      º
  46.             CASE 2: romanToArabic '       º we do?       º
  47.             CASE -1: sayGoodbye '         º              º
  48.         END SELECT '                     ͼ              º
  49.     LOOP UNTIL KeyPress$ <> "" ' ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
  50.  
  51.     IF KeyPress$ = CHR$(13) THEN ' if ENTER pressed                   ÍÍÍÍÍ»
  52.         SELECT CASE menuHighlight% '                                       º
  53.             CASE 1: actualMenuWorking% = 1 '                               º
  54.             CASE 2: actualMenuWorking% = 2 '                               º analyze and react
  55.             CASE 3: actualMenuWorking% = -1 '                              º to user input for
  56.         END SELECT '                                                       º the MAIN MENU
  57.     ELSEIF KeyPress$ = CHR$(0) + "H" THEN ' if UP arrow pressed            º
  58.         IF menuHighlight% <> 1 THEN menuHighlight% = menuHighlight% - 1 '  º
  59.     ELSEIF KeyPress$ = CHR$(0) + "P" THEN ' if DOWN arrow pressed          º
  60.         IF menuHighlight% <> 3 THEN menuHighlight% = menuHighlight% + 1 '  º
  61.     ELSEIF KeyPress$ = CHR$(27) THEN '                                     º
  62.         menuHighlight% = 3 '                                               º
  63.     END IF '                                                          ÍÍÍÍͼ
  64.  
  65.  
  66.  
  67. '--------------* Functions *--------------
  68. FUNCTION turnIntegerToRoman$ (inputNumber%)
  69.  
  70.     numberAsString$ = LTRIM$(STR$(inputNumber%)) '                              turn number into s string, no spaces
  71.     IF inputNumber% > 0 AND inputNumber% < 4000 THEN '                          check if number inside range
  72.         digits% = LEN(numberAsString$) '                                        how many digits it has?
  73.         REDIM tmpArray%(digits%) '                                              make an integer array of that many digits long
  74.         REDIM subResult$(digits%) '                                             and another one, but string type, forbuilding the result
  75.         FOR i% = 0 TO digits% - 1 '                                             cicle for every digit
  76.             tmpArray%(i%) = VAL(MID$(numberAsString$, digits% - i%, 1)) '       save in the integer array the value of the digit
  77.             subResult$(i%) = resultPieces$(i%, tmpArray%(i%)) '                 in the string array save the piece according with value and
  78.             result$ = subResult$(i%) + result$ '                                keep building result with pieces untill finish cicling
  79.         NEXT i%
  80.         COLOR GREEN '                                                           since numbar was in range we are allowed to send a good answer
  81.         turnIntegerToRoman$ = result$ '                                         wich we just built
  82.     ELSE '                                                                      but if number was not in range
  83.         COLOR RED '                                                             something bad happenen, so red color
  84.         turnIntegerToRoman$ = "I can't convert " + numberAsString$ '            and we warn about it
  85.     END IF
  86.  
  87.  
  88. '- - - - - - - - - - - - - - - - - - - - - -
  89. FUNCTION turnRomanToInteger$ (inputRoman$)
  90.  
  91.     tmpRomanToCompare$ = "" '                                                   we make a temporary variable to place built romans to compare with user input
  92.  
  93.     FOR i% = 3999 TO 1 STEP -1 '                                                we gonna check all possible numbers
  94.         tmpRomanToCompare$ = turnIntegerToRoman$(i%) '                          make a temporal roman number
  95.         IF tmpRomanToCompare$ = inputRoman$ THEN '                              and compare to user input
  96.             COLOR GREEN '                                                       if its the same is all good
  97.             turnRomanToInteger$ = LTRIM$(STR$(i%)) '                            we can send the result as string, no spaces
  98.             EXIT FUNCTION '                                                     and leave here
  99.         END IF
  100.     NEXT i%
  101.  
  102.     COLOR RED '                                                                 but if no coincidence was made something is wrong
  103.     turnRomanToInteger$ = "Not a roman!" '                                      we should warn it
  104.  
  105.  
  106. '--------------* Subroutines *--------------
  107. SUB sayHello ()
  108.  
  109.     helloMessage1$ = "       Hello my master"
  110.     helloMessage2$ = "  Order me and i will obey..."
  111.  
  112.     COLOR GREEN
  113.  
  114.     i% = 0 '                                                   ÍÍÍÍ»
  115.     DO '                                                           º
  116.         _DELAY .05 '                                               º
  117.         i% = i% + 1 '                                              º print helloMessage1$
  118.         buildingMessage$ = LEFT$(helloMessage1$, i%) + CHR$(219) ' º character by character
  119.         LOCATE 3, 1 '                                              º and erease the cursor
  120.         PRINT buildingMessage$ '                                   º
  121.     LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage1$) + 1 '   º
  122.     LOCATE CSRLIN - 1, LEN(helloMessage1$) + 1: PRINT " " '    ÍÍÍͼ
  123.  
  124.     i% = 0 '                                                   ÍÍÍÍ»
  125.     DO '                                                           º
  126.         _DELAY .05 '                                               º
  127.         i% = i% + 1 '                                              º print helloMessage2$
  128.         buildingMessage$ = LEFT$(helloMessage2$, i%) + CHR$(219) ' º character by character
  129.         LOCATE 4, 1 '                                              º and erease the cursor
  130.         PRINT buildingMessage$ '                                   º
  131.     LOOP UNTIL LEN(buildingMessage$) = LEN(helloMessage2$) + 1 '   º
  132.     LOCATE CSRLIN - 1, LEN(helloMessage2$) + 1: PRINT " " '    ÍÍÍͼ
  133.  
  134.     SLEEP 2
  135.  
  136.  
  137. '- - - - - - - - - - - - - - - - - - - - - -
  138. SUB printMainMenu ()
  139.  
  140.     SHARED menuHighlight%
  141.  
  142.     CLS
  143.  
  144.     LOCATE 1, 1 '                                          ÍÍÍ»
  145.     COLOR WHITE '                                             º Title
  146.     PRINT "     Roman/Arabic Conversor"; '                 ÍÍͼ
  147.     LOCATE 2, 1 '                                          ÍÍÍ»
  148.     PRINT SPACE$(5);: PRINT STRING$(22, CHR$(223)); '      ÍÍͼ Underline
  149.  
  150.     IF menuHighlight% = 1 THEN '                           ÍÍÍ»
  151.         COLOR YELLOW '                                        º
  152.         LOCATE 3, 7 '                                         º
  153.         PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27); ' º
  154.     ELSE '                                                    º Arabic  Roman
  155.         COLOR DARKGRAY '                                      º
  156.     END IF '                                                  º
  157.     LOCATE 3, 9 '                                             º
  158.     PRINT "Arabic  Roman"; '                              ÍÍͼ
  159.  
  160.     IF menuHighlight% = 2 THEN '                           ÍÍÍ»
  161.         COLOR YELLOW '                                        º
  162.         LOCATE 4, 7 '                                         º
  163.         PRINT CHR$(26);: PRINT SPACE$(16);: PRINT CHR$(27); ' º
  164.     ELSE '                                                    º Roman  Arabic
  165.         COLOR DARKGRAY '                                      º
  166.     END IF '                                                  º
  167.     LOCATE 4, 9 '                                             º
  168.     PRINT "Roman  Arabic"; '                              ÍÍͼ
  169.  
  170.     IF menuHighlight% = 3 THEN '                           ÍÍÍ»
  171.         COLOR YELLOW '                                        º
  172.         LOCATE 5, 12 '                                        º
  173.         PRINT CHR$(26);: PRINT SPACE$(6);: PRINT CHR$(27); '  º
  174.     ELSE '                                                    º Exit
  175.         COLOR DARKGRAY '                                      º
  176.     END IF '                                                  º
  177.     LOCATE 5, 14 '                                            º
  178.     PRINT "Exit"; '                                        ÍÍͼ
  179.  
  180.     COLOR WHITE '                                          ÍÍÍ»
  181.     LOCATE 6, 1 '                                             º Instructions
  182.     PRINT " UP-DOWN select / ENTER choose"; '              ÍÍͼ
  183.  
  184.     _DISPLAY
  185.  
  186.  
  187. '- - - - - - - - - - - - - - - - - - - - - -
  188. SUB arabicToRoman ()
  189.  
  190.     SHARED actualMenuWorking%
  191.  
  192.     subInput$ = ""
  193.     num% = 0
  194.  
  195.     DO
  196.         DO '                         ÍÍ»
  197.             CLS '                      º
  198.             COLOR WHITE '                               ÍÍÍÍ»
  199.             LOCATE 1, 1 '                                   º istructions
  200.             PRINT "Give me a number from 1 to 3999" '       º for user
  201.             PRINT "     Press ESC to go back" '         ÍÍÍͼ
  202.             PRINT "          > ";: PRINT subInput$ + CHR$(95) ' what user writes
  203.             PRINT
  204.             PRINT num%; "= "; turnIntegerToRoman$(num%); ' what user want's to see
  205.             KeyPress$ = INKEY$ '       º get a key
  206.             _LIMIT 20 '                º from user
  207.             _DISPLAY '                 º
  208.         LOOP UNTIL KeyPress$ <> "" ' Íͼ
  209.  
  210.         'NUMBERS
  211.         IF (ASC(KeyPress$) > 47 AND ASC(KeyPress$) < 58) THEN 'if NUMBER pressed and the subInput$ is not longer
  212.             IF LEN(subInput$) < 4 THEN subInput$ = subInput$ + KeyPress$ '    than 4 then increase the subInput$
  213.  
  214.             'BACKSPACE
  215.         ELSEIF KeyPress$ = CHR$(8) THEN '                   if BACKSPACE pressed and subInput ain't null
  216.             IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
  217.  
  218.             ' ENTER
  219.         ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
  220.             IF subInput$ <> "" THEN '       subInput$ ain't null then
  221.                 num% = VAL(subInput$) '     turn to a value and save it to num%
  222.                 subInput$ = "" '            and clear subInput$
  223.             END IF
  224.         END IF
  225.  
  226.         'ESC
  227.     LOOP UNTIL KeyPress$ = CHR$(27)
  228.     actualMenuWorking% = 0
  229.  
  230.  
  231. '- - - - - - - - - - - - - - - - - - - - - -
  232. SUB romanToArabic ()
  233.  
  234.     SHARED actualMenuWorking%
  235.  
  236.     subInput$ = ""
  237.     lastInput$ = "I"
  238.  
  239.     DO
  240.         DO '                         ÍÍ»
  241.             CLS '                      º
  242.             COLOR WHITE '                               ÍÍÍÍ»
  243.             LOCATE 1, 1 '                                   º istructions
  244.             PRINT "Give me a number from 1 to 3999" '       º for user
  245.             PRINT "     Press ESC to go back" '         ÍÍÍͼ
  246.             PRINT "      > ";: PRINT subInput$ + CHR$(95) ' what user writes
  247.             PRINT
  248.             PRINT " "; lastInput$; " = "; turnRomanToInteger$(lastInput$); ' what user want's to see
  249.             KeyPress$ = INKEY$ '       º get a key
  250.             _LIMIT 20 '                º from user
  251.             _DISPLAY '                 º
  252.         LOOP UNTIL KeyPress$ <> "" ' Íͼ
  253.  
  254.         'LETTERS
  255.         IF LEN(subInput$) < 15 THEN ' if roman not longer than 15 (MMMDCCCLXXXVIII)
  256.             SELECT CASE ASC(KeyPress$) ' only valid letters
  257.                 CASE 73 OR 105: subInput$ = subInput$ + KeyPress$ ' I
  258.                 CASE 86 OR 118: subInput$ = subInput$ + KeyPress$ ' V
  259.                 CASE 88 OR 120: subInput$ = subInput$ + KeyPress$ ' X
  260.                 CASE 76 OR 108: subInput$ = subInput$ + KeyPress$ ' L
  261.                 CASE 67 OR 99: subInput$ = subInput$ + KeyPress$ '  C
  262.                 CASE 68 OR 100: subInput$ = subInput$ + KeyPress$ ' D
  263.                 CASE 77 OR 109: subInput$ = subInput$ + KeyPress$ ' M
  264.             END SELECT
  265.         END IF
  266.  
  267.         'BACKSPACE
  268.         IF KeyPress$ = CHR$(8) THEN ' if BACKSPACE pressen and subInput ain't null
  269.             IF subInput$ <> "" THEN subInput$ = LEFT$(subInput$, LEN(subInput$) - 1) 'one less character
  270.  
  271.             ' ENTER
  272.         ELSEIF KeyPress$ = CHR$(13) THEN '  if ENTER pressed and
  273.             IF subInput$ <> "" THEN '       subInput$ ain't null then
  274.                 lastInput$ = subInput$ '    do as user says
  275.                 subInput$ = "" '            and clear subInput$
  276.             END IF
  277.         END IF
  278.  
  279.         subInput$ = UCASE$(subInput$) ' in case user dosn't use uppers
  280.  
  281.         'ESC
  282.     LOOP UNTIL KeyPress$ = CHR$(27)
  283.     actualMenuWorking% = 0
  284.  
  285.  
  286. '- - - - - - - - - - - - - - - - - - - - - -
  287. SUB sayGoodbye ()
  288.  
  289.     CLS
  290.  
  291.     goodbyeMessage$ = "Have a nice day!"
  292.  
  293.     COLOR RED '                                              ÍÍÍ»
  294.     LOCATE 3, 7 '                                               º
  295.     PRINT CHR$(3) '                                             º Hearts
  296.     LOCATE 3, 26 '                                              º
  297.     PRINT CHR$(3) '                                          ÍÍͼ
  298.  
  299.     COLOR GREEN '                                            ÍÍÍ»
  300.     i% = 0 '                                                    º
  301.     DO '                                                        º print goodbyeMessage$
  302.         _DELAY .05 '                                            º character by character
  303.         i% = i% + 1 '                                           º
  304.         buildingMessage$ = LEFT$(goodbyeMessage$, i%) '         º
  305.         LOCATE 3, 9 '                                           º
  306.         PRINT buildingMessage$ '                                º
  307.         _DISPLAY '                                              º
  308.     LOOP UNTIL LEN(buildingMessage$) = LEN(goodbyeMessage$) 'ÍÍͼ
  309.  
  310.     SLEEP 2 '                                                ÍÍÍ»
  311.     SYSTEM '                                                 ÍÍͼ Wait & kill
  312.  
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit 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!
Title: Re: Decimal to roman numbers converter
Post by: FellippeHeitor on August 31, 2020, 07:27:57 pm
Very nice minimalistic interface, and sweet good-bye message. Good job!
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit 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?)
Title: Re: Decimal to roman numbers converter
Post by: FellippeHeitor 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?
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on August 31, 2020, 09:48:29 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?


Title: Re: Decimal to roman numbers converter
Post by: bplus 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.
Title: Re: Decimal to roman numbers converter
Post by: euklides 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
Title: Re: Decimal to roman numbers converter
Post by: Ashish 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]
  1. _TITLE "Arabic To Roman : By Ashish"
  2. TYPE dict
  3.     c AS STRING * 2 'roman literal
  4.     n AS _UNSIGNED INTEGER 'its equivalent in arabic
  5.  
  6. DIM SHARED roman_literal(12) AS dict
  7. FOR i = 0 TO UBOUND(roman_literal) 'store the value in the array
  8.     READ roman_literal(i).n, roman_literal(i).c
  9. q~& = -1
  10. PRINT "Arabic to Roman Converter [ 1 to "; q~&; "] : By Ashish"
  11.     INPUT ">", num
  12.     PRINT ArabicToRoman(num)
  13. LOOP UNTIL num = 0
  14. 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"
  15.  
  16. FUNCTION ArabicToRoman$ (n~&)
  17.     IF n~& >= 4000 THEN
  18.         k~& = INT(n~& / 1000)
  19.         ArabicToRoman$ = ArabicToRoman$(k~&) + " " + ArabicToRoman$(n~& - (k~& - 1) * 1000)
  20.     ELSE
  21.         IF n~& = 0 THEN PRINT "invalid": EXIT FUNCTION
  22.         ArabicToRoman$ = __internal_convertArabicToRoman(n~&)
  23.     END IF
  24. FUNCTION __internal_convertArabicToRoman$ (n~&)
  25.     i~& = UBOUND(roman_literal)
  26.     x~& = n~&
  27.     DO
  28.         IF x~& >= roman_literal(i~&).n AND x~& < 4 * roman_literal(i~&).n THEN
  29.             p~& = INT(x~& / roman_literal(i~&).n)
  30.             __internal_convertArabicToRoman$ = __internal_convertArabicToRoman$ + strRepeat(p~&, roman_literal(i~&).c)
  31.             x~& = x~& - (roman_literal(i~&).n * p~&)
  32.         ELSE
  33.             i~& = i~& - 1 'move below in the array
  34.         END IF
  35.     LOOP UNTIL x~& = 0
  36.     s = RTRIM$(s)
  37.     FOR i~& = 1 TO n
  38.         strRepeat$ = strRepeat$ + s
  39.     NEXT
  40.  
Title: Re: Decimal to roman numbers converter
Post by: bplus on September 01, 2020, 11:37:41 am
Hi @Ashish

Code: QB64: [Select]
  1.     INPUT ">", num
  2.     PRINT ArabicToRoman(num)
  3. LOOP UNTIL num = 0
  4.  

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]
  1. 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!
Title: Re: Decimal to roman numbers converter
Post by: Ashish on September 01, 2020, 11:44:28 am
@bplus thanks. I have just edited it. :)
Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1. 'ANR = 2020 'Euklides vers 2020-09-01 https://www.qb64.org/forum/index.php?topic=2960.msg122293#msg122293
  2. 'GOSUB romain
  3. 'PRINT rom$
  4. 'END
  5.  
  6. '>>> b+ mod to convert to handy Function  2020-09-01
  7.     PRINT: PRINT "0 or less quits"
  8.     INPUT "Enter 1 to 3999 a number to convert to Roman: "; anr
  9.     PRINT "romain returned "; romain$(anr)
  10.     IF anr <= 0 THEN END
  11.  
  12. FUNCTION romain$ (anr)
  13.     aro# = anr 'copy anr so it's not changed
  14.     IF aro# <= 0 THEN romain$ = "Zéro": EXIT FUNCTION '<<< add = to < for compare
  15.     IF aro# > 3999 THEN romain$ = "????": EXIT FUNCTION
  16.     IF aro# >= 3000 THEN rom$ = rom$ + "MMM": aro# = aro# - 3000
  17.     IF aro# >= 2000 THEN rom$ = rom$ + "MM": aro# = aro# - 2000
  18.     IF aro# >= 1000 THEN rom$ = rom$ + "M": aro# = aro# - 1000
  19.     IF aro# >= 900 THEN rom$ = rom$ + "CM": aro# = aro# - 900
  20.     IF aro# >= 800 THEN rom$ = rom$ + "DCCC": aro# = aro# - 800
  21.     IF aro# >= 700 THEN rom$ = rom$ + "DCC": aro# = aro# - 700
  22.     IF aro# >= 600 THEN rom$ = rom$ + "DC": aro# = aro# - 600
  23.     IF aro# >= 500 THEN rom$ = rom$ + "D": aro# = aro# - 500
  24.     IF aro# >= 400 THEN rom$ = rom$ + "CD": aro# = aro# - 400
  25.     IF aro# >= 300 THEN rom$ = rom$ + "CCC": aro# = aro# - 300
  26.     IF aro# >= 200 THEN rom$ = rom$ + "CC": aro# = aro# - 200
  27.     IF aro# >= 100 THEN rom$ = rom$ + "C": aro# = aro# - 100
  28.     IF aro# >= 90 THEN rom$ = rom$ + "XC": aro# = aro# - 90
  29.     IF aro# >= 80 THEN rom$ = rom$ + "LXXX": aro# = aro# - 80
  30.     IF aro# >= 70 THEN rom$ = rom$ + "LXX": aro# = aro# - 70
  31.     IF aro# >= 60 THEN rom$ = rom$ + "LX": aro# = aro# - 60
  32.     IF aro# >= 50 THEN rom$ = rom$ + "L": aro# = aro# - 50
  33.     IF aro# >= 40 THEN rom$ = rom$ + "XL": aro# = aro# - 40
  34.     IF aro# >= 30 THEN rom$ = rom$ + "XXX": aro# = aro# - 30
  35.     IF aro# >= 20 THEN rom$ = rom$ + "XX": aro# = aro# - 20
  36.     IF aro# >= 10 THEN rom$ = rom$ + "X": aro# = aro# - 10
  37.     IF aro# >= 9 THEN rom$ = rom$ + "IX": aro# = aro# - 9
  38.     IF aro# >= 8 THEN rom$ = rom$ + "VIII": aro# = aro# - 8
  39.     IF aro# >= 7 THEN rom$ = rom$ + "VII": aro# = aro# - 7
  40.     IF aro# >= 6 THEN rom$ = rom$ + "VI": aro# = aro# - 6
  41.     IF aro# >= 5 THEN rom$ = rom$ + "V": aro# = aro# - 5
  42.     IF aro# >= 4 THEN rom$ = rom$ + "IV": aro# = aro# - 4
  43.     IF aro# >= 3 THEN rom$ = rom$ + "III": aro# = aro# - 3
  44.     IF aro# >= 2 THEN rom$ = rom$ + "II": aro# = aro# - 2
  45.     IF aro# >= 1 THEN rom$ = rom$ + "I": aro# = aro# - 1
  46.     romain$ = rom$
  47.  
Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1. _TITLE "Roman MOD post Ashish" 'b+ 2020-09-01 combine Ashish down to one independent Function 29 lines!
  2. q~& = -1
  3. PRINT "Arabic to Roman Converter [ 1 to "; q~&; "] : By Ashish"
  4.     INPUT "Enter Arabic to convert to Roman >", num
  5.     PRINT A2R$(num)
  6. LOOP UNTIL num = 0
  7. FUNCTION A2R$ (nn AS _UNSIGNED LONG) 'Arabic positive integer to Roman string
  8.     STATIC d(12) AS _UNSIGNED LONG, c(12) AS STRING
  9.     IF d(0) = 0 THEN ' load n and c arrays
  10.         FOR ub = 0 TO 12
  11.             READ d(ub), c(ub)
  12.         NEXT
  13.     END IF
  14.     n = nn 'private copy of nn because we will be recursive
  15.     IF n >= 4000 THEN
  16.         k = INT(n / 1000)
  17.         A2R$ = LCASE$(A2R$(k)) + "*" + A2R$(n - (k - 1) * 1000)
  18.     ELSE
  19.         IF n = 0 THEN PRINT "invalid": EXIT FUNCTION
  20.         ub = 12: x = n
  21.         DO ' *** Ashish uses same method as Euklides but condensed beautifully here ***
  22.             IF x >= d(ub) AND x < 4 * d(ub) THEN ' x falls between which two decimal amounts?
  23.                 p = INT(x / d(ub)): s = "" 'setup to copy Roman symbol(s) p times
  24.                 FOR i = 1 TO p: s = s + c(ub): NEXT 'string copy
  25.                 A2R$ = A2R$ + s: x = x - d(ub) * p
  26.             ELSE
  27.                 ub = ub - 1 'move index ub down
  28.             END IF
  29.         LOOP UNTIL x = 0
  30.     END IF
  31.     EXIT FUNCTION 'below is nice condensed data Ashish uses same method as Euklides but condensed beautifully
  32.     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"
  33.  





Title: Re: Decimal to roman numbers converter
Post by: bplus 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]
  1. _TITLE "Roman$ Function Test and Demo" ' b+ 2020-09-01 revise Roman SUB to latest changes at forum
  2. DIM q~&, output$, num AS _UNSIGNED LONG, test$
  3. q~& = -1: num = 4294967295 'quick test of big number limit
  4. PRINT num; "= "; Roman$(STR$(num))
  5. '         4294967295    4294967295   'limit
  6. FOR num = 4200000000 TO 4200000020
  7.     output$ = Roman$(STR$(num))
  8.     test$ = Roman$(output$)
  9.     LOCATE CSRLIN, 1: PRINT num;
  10.     LOCATE CSRLIN, 20: PRINT output$;
  11.     LOCATE CSRLIN, 50: PRINT test$
  12.     IF num <> VAL(test$) THEN BEEP: SLEEP
  13.     PRINT " Testing conversion of numbers 0 to"; q~&; " to or from Roman Numerals >"
  14.     INPUT " Enter a string to test "; test$
  15.     output$ = Roman$(test$)
  16.     PRINT " The Roman SUB returned: "; output$
  17.     PRINT
  18. LOOP UNTIL test$ = ""
  19.  
  20. FUNCTION Roman$ (instrg$) ' for extended Roman Numeral conversions
  21.     STATIC d(12) AS _UNSIGNED LONG, c(12) AS STRING, R$(1 TO 3999)
  22.     DIM pd AS INTEGER, pr AS INTEGER, lastpd AS INTEGER, lastpr AS INTEGER
  23.     IF d(0) = 0 THEN ' load n and c arrays
  24.         FOR ub = 0 TO 12
  25.             READ d(ub), c(ub)
  26.         NEXT
  27.         FOR i = 1 TO 3999
  28.             ub = 12: x = i: conv = ""
  29.             DO ' *** Ashish uses same method as Euklides but condensed beautifully here ***
  30.                 IF x >= d(ub) AND x < 4 * d(ub) THEN ' x falls between which two decimal amounts?
  31.                     p = INT(x / d(ub)): s = "" 'setup to copy Roman symbol(s) p times
  32.                     FOR j = 1 TO p: s = s + c(ub): NEXT 'string copy
  33.                     conv = conv + s: x = x - d(ub) * p
  34.                 ELSE
  35.                     ub = ub - 1 'move index ub down
  36.                 END IF
  37.             LOOP UNTIL x = 0
  38.             R$(i) = conv
  39.         NEXT
  40.     END IF 'end of setup, one time only
  41.     s = _TRIM$(UCASE$(instrg$))
  42.     IF s = "" OR s = "0" THEN Roman$ = "Error: nada": EXIT FUNCTION 'handle nothing
  43.     FOR i = 1 TO LEN(s) ' character checkup
  44.         pd = INSTR("0123456789", MID$(s, i, 1)): pr = INSTR(" MDCLXVI", MID$(s, i, 1))
  45.         IF pd = 0 AND pr = 0 THEN Roman$ = "Error: unknown character.": EXIT SUB 'handle wrong alpha
  46.         IF i > 1 THEN 'check for mixed messages
  47.             IF (lastpd = 0 AND pd > 0) OR (lastpr = 0 AND pr > 0) THEN Roman$ = "Error: digits mixed with letters.": EXIT SUB
  48.         END IF
  49.         lastpd = pd: lastpr = pr
  50.     NEXT
  51.     v = VAL(s) 'is s a number or a Roman Numeral string?
  52.     IF v = 0 THEN
  53.         REDIM vs(0) AS STRING ' vs for value strings
  54.         Split s, " M", vs() '   Handy Split for parsing *M sections
  55.         conv = "" '             Build our string on this variable (reusing)
  56.         FOR j = 0 TO UBOUND(vs)
  57.             pd = 0 'reuse an integer for found match
  58.             FOR i = 1 TO 3999
  59.                 IF R$(i) = vs(j) THEN ' When stringing together numbers after first set need 0 fillers.
  60.                     IF j > 0 THEN conv = conv + RIGHT$("000" + _TRIM$(STR$(i)), 3) ELSE conv = conv + _TRIM$(STR$(i))
  61.                     pd = 1: EXIT FOR 'pd indeicates a match was found
  62.                 END IF
  63.             NEXT
  64.             IF pd <> 1 THEN ' No match found, maybe this is empty 000 space?
  65.                 IF vs(j) = "" THEN conv = conv + "000" ELSE Roman$ = "Error: Invalid Roman Numeral? string.": EXIT FUNCTION
  66.             END IF
  67.         NEXT
  68.         Roman$ = conv
  69.     ELSEIF v >= 4000 THEN ' Beyond our Roman String Table
  70.         k = INT(v / 1000)
  71.         Roman$ = Roman$(STR$(k)) + " " + Roman$(STR$(v - (k - 1) * 1000)) ' Go recursive until v < 4000
  72.     ELSE
  73.         Roman$ = R$(v) 'Table lookup
  74.     END IF
  75.     EXIT SUB 'below is nice condensed data Ashish uses same method as Euklides but condensed beautifully
  76.     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"
  77.  
  78. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  79.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  80.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  81.     dpos = INSTR(curpos, SplitMeString, delim)
  82.     DO UNTIL dpos = 0
  83.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  84.         arrpos = arrpos + 1
  85.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
  86.         curpos = dpos + LD
  87.         dpos = INSTR(curpos, SplitMeString, delim)
  88.     LOOP
  89.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  90.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
  91.  
  92.  
Title: Re: Decimal to roman numbers converter
Post by: Ashish on September 02, 2020, 12:12:57 am
@bplus great! :)
You documented my part of my code very well... I will need your help in future. LOL
Title: Re: Decimal to roman numbers converter
Post by: Ashish on September 02, 2020, 01:06:09 am
This is my approach for converting Roman into Arabic Number System.

Code: QB64: [Select]
  1. _TITLE "Roman To Arabic Convertor : By Ashish" 'Roman To Arabic Convertor : By Ashish  [2 Sep, 2020]
  2. 'NOTE:RomanToArabic~&() function assume that roman number passed to it does not have any error (except for non-roman literal)
  3.     INPUT "> ", roman$
  4.     PRINT RomanToArabic~&(roman$)
  5. LOOP UNTIL roman$ = ""
  6.  
  7. FUNCTION RomanToArabic~& (r$)
  8.     DIM x~%, y~%, mult AS _BYTE
  9.     y~% = 9
  10.     FOR i~& = 1 TO LEN(r$)
  11.         x~% = INSTR("IVXLCDM ", UCASE$(MID$(r$, i~&, 1)))
  12.         IF x~% = 0 THEN
  13.             PRINT "ERROR": EXIT FUNCTION
  14.         ELSE
  15.             IF LEN(r$) = 1 AND i~& = 1 THEN
  16.                 RomanToArabic~& = 2 ^ (INT((x~% - 1) / 2)) * 5 ^ (INT(x~% / 2)): EXIT FUNCTION
  17.             ELSE
  18.                 IF x~% = 8 THEN
  19.                     mult = 1
  20.                 ELSE
  21.                     IF mult = 1 THEN
  22.                         RomanToArabic~& = RomanToArabic~& * (2 ^ (INT((x~% - 1) / 2)) * 5 ^ (INT(x~% / 2)))
  23.                         mult = 0
  24.                     ELSE
  25.                         RomanToArabic~& = RomanToArabic~& + (2 ^ (INT((x~% - 1) / 2)) * 5 ^ (INT(x~% / 2)))
  26.                         IF y~% < x~% THEN RomanToArabic~& = RomanToArabic~& - 2 * (2 ^ (INT((y~% - 1) / 2)) * 5 ^ (INT(y~% / 2)))
  27.                     END IF
  28.                 END IF
  29.             END IF
  30.         END IF
  31.         IF x~% <> 8 THEN y~% = x~%
  32.     NEXT
  33.  
Title: Re: Decimal to roman numbers converter
Post by: Juan Tamarit on September 02, 2020, 01:30:16 am
This is my approach for converting Roman into Arabic Number System.

Code: QB64: [Select]
  1.         x~% = INSTR("IVXLCDM ", UCASE$(MID$(r$, i~&, 1)))
  2.  

This line is artistic
Title: Re: Decimal to roman numbers converter
Post by: bplus on September 02, 2020, 03:07:55 am
Nice work! @Ashish

I ran some tests and looked good, I will study what you did tomorrow.