Roman numeral to integer conversion

Source-code only - please, don't post questions here.
stylin
Posts: 1253
Joined: Nov 06, 2005 5:19

Roman numeral to integer conversion

Postby stylin » Jan 30, 2007 16:52

Hello ! In honor of black history month and the superbowl (go Colts), here's a procedure that returns an integer representation of a roman numerical string. Enjoy ! (an integer to roman numerical string procedure is coming shortly..)

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


edit: OK, apparently there are quite a few variations of the conversion over the centuries. The one presented here is the one I learned in school - the letters MDLCXVI, in decreasing order, adjacent letters in increasing order are subtracted, no multiplication with duplicated numerals, etc.

I might refactor to allow different parsing algorithms if anyone really wants the more obscure of them..
stylin
Posts: 1253
Joined: Nov 06, 2005 5:19

Postby stylin » Jan 30, 2007 19:44

Integer to roman numerical string procedure added, first post updated.

The new procedure is not fully optimised yet, eg. 9 converts to 'VIV' instead of 'IX'. Perhaps it might be a nice feature to allow both types of conversions.. OOP to the rescue..
Mysoft
Posts: 748
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Jan 31, 2007 1:32

ouch

i made the same exercice for my freebasic students, and i made one of this too, the code is pretty small, if you want to see i can post the code here, when i found it (is somewhat old) ^^"
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:

Postby acetoline » Jan 31, 2007 5:52

Nice prog.
The roman numerals we were taught were a bit different, but hey.
Veggiet
Posts: 156
Joined: Apr 17, 2006 19:41

Postby Veggiet » Jan 31, 2007 18:51

I remember writing one in qbasic when I first learned about roman numerals in school.
ytwinky
Posts: 217
Joined: Dec 03, 2005 12:44
Location: MD, Germany

Postby ytwinky » Feb 06, 2007 10:14

Hi,
nice program for my first experiments with namespaces :D
But I think four lines of code are enough for RomanDigitToLong:

Code: Select all

  Private Function RomanDigitToLong(RomanDigit As UByte) As Long
     Static DecValue(7) As Long={0, 1000, 500, 100, 50, 10, 5, 1}
     Return DecValue(InStr("MDCLXVI", UCase(Chr(RomanDigit))))
  End Function
tested with the build from yesterday
Regards
ytwinky
counting_pine
Site Admin
Posts: 5826
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Postby counting_pine » Feb 06, 2007 11:36

This is great stuff. Let's add the "&R" number format to FreeBASIC!

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 0 guests