The QBasic Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

  << Previous Topic | Next Topic >>Return to Index  

ProgramList Laanan Fisher

April 30 2007 at 5:53 PM
LaananFisher  (no login)

Hello. :)

(this didn't work the first time, trying again..)


    
This message has been edited by iorr5t on May 18, 2007 1:53 PM


 
 Respond to this message   
AuthorReply
LaananFisher
(no login)

Roman numeral and decimal conversion

April 30 2007, 6:14 PM 

Here is some code to help make it easier to work with roman numerals, enjoy. :)

(I've linked to copy-pasta.com because it preserves tabs and has some nice highlighting, plus selecting groups of code is done in one easy click)

[roman.bi] - header file for roman.bas, include this in your programs
http://copy-pasta.com/pasta498

[roman.bas] - module containing the conversion procedures, link this with your programs.
http://copy-pasta.com/pasta499

[demo.bas] - an example program
http://copy-pasta.com/pasta497

[Note from Mac]
Hi,Laanan,

Please don't link to other places that may or may not exist in the future and contain advertisements, etc.

I assembled your program and posted as a reply here in the manner of all other programs. Note that indentation can be preserved on this forum (see QB_FAQ on main program)

Otherwise, nice stuff! I did have to modify DecimalToRoman slightly to get past the bug that
for i=1 to 100: print DecimalToRoman(i): next i
failed to work since you modify the input parameter so that it always returns zero and gets stepped back to 1 and thus the loop never gets past 1.

I guess you never tried your example program, or it works differently on QB4.5. The change I made was

from
FUNCTION DecimalToRoman$ (n AS LONG)
to
FUNCTION DecimalToRoman$ (DecNum AS LONG)
DIM n AS LONG: n = DecNum


Mac




    
This message has been edited by iorr5t on May 3, 2007 7:24 AM


 
 Respond to this message   
For LaananFisher
(Premier Login iorr5t)
Forum Owner

Complete Demo

May 3 2007, 6:58 AM 

'' Copyright(c) 2007 Laanan Fisher
''
'' Use this code however you like. :)
''
''' These procedures validate roman numerical strings, and convert them
''' to and from decimal (LONG) values. Upper or lower case roman numerals
''' are both interpretted.
 
' Returns true (-1) if the entire string passed represents a valid roman
' numeral, or false (0) otherwise.
DECLARE FUNCTION IsValidRomanNumeral% (n AS STRING)
 
' Returns a decimal (LONG) representation of a roman numerical string
' using as many characters in the string as possible, or zero if the string
' starts with an invalid character.
DECLARE FUNCTION RomanToDecimal& (n AS STRING)
 
' Returns a roman numerical string representation of a decimal value, or the
' null string ("") if the value is negative.
DECLARE FUNCTION DecimalToRoman$ (n AS LONG)

CLS
DIM i AS LONG
PRINT "Demo"
FOR i = 1 TO 100: PRINT i; : PRINT DecimalToRoman(i), : NEXT i
PRINT
SYSTEM

'' :::::
FUNCTION DecimalToRoman$ (DecNum AS LONG)
DIM n AS LONG: n = DecNum
 
     ' table of roman numerals sorted in descending order.
     STATIC romanNumeralTable AS STRING
     STATIC tableInitialized AS INTEGER
     
     IF (NOT tableInitialized) THEN
          romanNumeralTable = "MDCLXVI"
          tableInitialized = -1
     END IF
     
     DIM result AS STRING
     DIM cur AS INTEGER: cur = 1
     
     WHILE (0 < n)
          DIM curValue AS LONG: curValue = RomanToDecimal&(MID$(romanNumeralTable, cur, 1))
          
          DIM numeralsNeeded AS INTEGER: numeralsNeeded = n \ curValue
          
          ' need more than 3 numerals ?
          IF (3 < numeralsNeeded) THEN
               ' not 'M' ? use subtraction principle..
               IF (1 <> cur) THEN
                    result = result + MID$(romanNumeralTable, cur, 1)
                    result = result + MID$(romanNumeralTable, cur - 1, 1)
                    n = n - (RomanToDecimal(MID$(romanNumeralTable, cur - 1, 1)) - curValue)
               END IF
          
          ' need 2 or 3 ? add them one by one..
          ELSEIF (1 < numeralsNeeded) THEN
               result = result + MID$(romanNumeralTable, cur, 1)
               n = n - curValue
          
          ' need only 1 numeral ?
          ' TODO: check for 'subtraction principle' of next and previous
          '       numeral, e.g., VIV -> IX, DCD -> CM
          ELSEIF (0 < numeralsNeeded) THEN
               result = result + MID$(romanNumeralTable, cur, 1)
               n = n - curValue
          
          ' else try next smallest numeral..
          ELSE
               cur = cur + 1
          END IF
     WEND
     DecimalToRoman$ = result
END FUNCTION

'' :::::
FUNCTION IsValidRomanNumeral% (n AS STRING)
 
     ' assume invalid numeral.
     IsValidRomanNumeral% = 0
     
     ' check each character..
     DIM position AS INTEGER
     FOR position = 1 TO LEN(n)
          IF (0 = RomanToDecimal&(MID$(n, position, 1))) THEN
               EXIT FUNCTION
          END IF
     NEXT
     
     IsValidRomanNumeral% = -1
 
END FUNCTION

'' :::::
FUNCTION RomanToDecimal& (n AS STRING)
 
     DIM length AS INTEGER: length = LEN(n)
     
     ' single digit ?
     IF (1 = length) THEN
          SELECT CASE ASC(UCASE$(n))
          CASE ASC("M"): RomanToDecimal& = 1000
          CASE ASC("D"): RomanToDecimal& = 500
          CASE ASC("C"): RomanToDecimal& = 100
          CASE ASC("L"): RomanToDecimal& = 50
          CASE ASC("X"): RomanToDecimal& = 10
          CASE ASC("V"): RomanToDecimal& = 5
          CASE ASC("I"): RomanToDecimal& = 1
          CASE ELSE: RomanToDecimal& = 0
          END SELECT
          EXIT FUNCTION
     END IF
     
     DIM result AS LONG
     DIM position AS INTEGER: position = 1
     
     WHILE (position <= length)
          ' last digit ?
          IF (position = length) THEN
               result = result + RomanToDecimal&(MID$(n, position, 1))
               RomanToDecimal& = result
               EXIT FUNCTION
          END IF
          
          ' look ahead in case of 'subtraction principle'..
          DIM cur AS LONG: cur = RomanToDecimal&(MID$(n, position, 1))
          DIM nxt AS LONG: nxt = RomanToDecimal&(MID$(n, position + 1, 1))
          
          ' parse as many valid numerals as possible..
          IF (0 = cur) THEN
               RomanToDecimal& = result
               EXIT FUNCTION
          END IF
          IF (0 = nxt) THEN
               RomanToDecimal& = result + cur
               EXIT FUNCTION
          END IF
          
          ' need to apply 'subtraction principle' ?
          IF (cur < nxt) THEN
               result = result + nxt - cur
               position = position + 2
          ELSE
               result = result + cur
               position = position + 1
          END IF
     WEND
     
     RomanToDecimal& = result
     
END FUNCTION


 
 Respond to this message   
Current Topic - ProgramList Laanan Fisher
  << Previous Topic | Next Topic >>Return to Index