Code: Select all
'' Copyright(c) 2007 Laanan Fisher
'' numeric-roman.bi
''
namespace numeric
'' Returns true if the string passed represents a valid roman numeral.
declare function IsValidRomanNumeral (byref n as string) as integer
'' Returns the integer representation of a roman numerical string.
''
'' If the string contains invalid characters, as much of the string will be
'' interpretted as possible. Upper and lower case roman numerals are
'' accepted.
declare function RomanToInteger(byref n as string) as integer
'' Returns a roman numerical string representation of an integer value.
declare function IntegerToRoman (n as integer) as string
end namespace
'' numeric-roman.bas
''
namespace numeric
'' Returns the integer representation of a roman numerical digit, or
'' 0 if the digit is not a roman numeral.
private _
function RomanDigitToInteger(d as ubyte) as integer
select case asc(ucase(chr(d)))
case asc("M") : return 1000
case asc("D") : return 500
case asc("C") : return 100
case asc("L") : return 50
case asc("X") : return 10
case asc("V") : return 5
case asc("I") : return 1
case else
return 0
end select
end function
function IsValidRomanNumeral (byref n as string) as integer
' assume an invalid numeral
function = 0
for it as ubyte ptr = @n[0] to @n[len(n) - 1]
if (0 = RomanDigitToInteger(*it)) then
exit function
end if
next
function = -1
end function
function RomanToInteger (byref n as string) as integer
dim result as integer = 0
dim it as ubyte ptr = @n[0]
while (it < @n[len(n)])
' we're at the last digit
if (it = @n[len(n) - 1]) then
result += RomanDigitToInteger(*it)
return result
end if
' look ahead in case of 'subtraction principle'
dim cur as integer = RomanDigitToInteger(*it)
dim nxt as integer = RomanDigitToInteger(*(it + 1))
' parse as many valid numerals as possible
if (0 = cur) then return result
if (0 = nxt) then return result + cur
' if we need to apply 'subtraction principle'..
if (cur < nxt) then
result += nxt - cur
it += 2
else
result += cur
it += 1
end if
wend
return result
end function
function IntegerToRoman (n as integer) as string
static romanNumeralTable(6) as ubyte = _
{ asc("M"), asc("D"), asc("C"), asc("L"), asc("X"), asc("V"), asc("I") }
dim result as string
dim cur as integer = 0
while (0 < n)
dim curValue as integer = RomanDigitToInteger(romanNumeralTable(cur))
' if we need more than 3 numerals..
if (3 < (n \ curValue)) then
' and they're not 'M', use the 'subtraction principle'
if (0 <> cur) then
result += chr(romanNumeralTable(cur), romanNumeralTable(cur - 1))
n -= RomanDigitToInteger(romanNumeralTable(cur - 1)) _
- curValue
end if
/'
' or if we only need 1..
elseif (1 = (n \ curValue)) then
' somehow check for subtraction principle of next and previous
' numeral, eg, VIV -> IX, DCD-> CM
'/
' or if we need 2 or 3, just add them one by one
elseif (0 < (n \ curValue)) then
result += chr(romanNumeralTable(cur))
n -= curValue
' else try the next smallest numeral
else
cur += 1
end if
wend
return result
end function
end namespace
I might refactor to allow different parsing algorithms if anyone really wants the more obscure of them..