'' 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
? numeric.IntegerToRoman(57)
sleep