| ProgramList Laanan FisherApril 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
|
|
| | Author | Reply | 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
|
|
| 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
|
| | Current Topic - ProgramList Laanan Fisher |
| |
|
|