Roman Numeral Calculator

[leinad31]

But I'm having problems trying to write the validation rules for:

• making sure the numeral that is entered is in the correct order
• the additive rule (explained above)

My previous post was hasty so...

As with any string manipulation routine, you will have to prepare your string to facilitate manipulation, eg. no spaces, UCase(), and so on. Use the validate event of the textbox. I used only one textbox in my tests.

You will then have to parse the roman expression and place it in a structure to facilitate iteration through the operands and operators. I found inserting vbCrLf works.

Public Sub ExpressionToArray(ByVal Expression As String, RetArray() As String) As Long 
   ExpressionToArray = -1  'init value
 
   'It is assumed that spaces have already been eliminated
   Expression = Replace(Expression, "+", vbCrLf & "+" & vbCrLf)
   Expression = Replace(Expression, "-", vbCrLf & "-" & vbCrLf)
   Expression = Replace(Expression, "*", vbCrLf & "*" & vbCrLf)
   Expression = Replace(Expression, "/", vbCrLf & "/" & vbCrLf)
 
   'You can insert a check here
   'If there is a leading or trailing vbCrLf, or there are two consecutive vbCrLf's 
   '   in the expression then you are lacking operands or have to many operators
 
   RetArray = Split(Expression, vbCrLf)
   ExpressionToArray = 0
End Sub
 
'You can then iterate on the returned array, eg:
'
'Dim sArray() As String
'
'   Call ExpressionToArray(txtInput.Text, sArray)
'   For x=0 To Ubound(sArray)
'      Select Case sArray(x)
'      Case "+", "-", "*", "/"
'         'do nothing, skip operators
'      Case Else
'         Call RomanToDecimal(sArray(x))  'pass the roman operand and update array value
'      End Select
'   Next
'
'   txtOutput.Text = EvaluateExpression(Join(sArray, ""))

You can then do 3 levels of validation on each roman operand:
- An initial check to screen out invalid characters (A, B, E...) and the more obvious errors such as IL or VV. This can easily be accomplished with InStr() > 0

- Validity checks during the conversion into an expression based on places (thousands, hundreds, tens, and ones as mentioned in Rhino's link).

- Rechecking the expression to make sure that the values progress from thousands place to ones correctly as I explained in an earlier post.

Conversion based on digit place is a lot easier than nested conditional statements to process the string from left to right. You will also need a sub to count the number of instances of your roman character.

Public Function CharCount(RomanChar As String, Expression As String) As Long
Dim sTemp As String
 
   sTemp = Replace(Expression, RomanChar, "")
   CharCount = (Len(Expression) - Len(sTemp)) / Len(RomanChar)
End Function
 
Public Function RomanToDecimal(ByRef RomanNum As String) As Long
'note that I passed by reference so I can update the value of RomanNum in the called procedure
 
   RomanToDecimal = -1
 
   If SimpleCheck(RomanNum)  <> ) Then error occured 'check for common errors and invalid letters
   If ReplaceOnes(RomanNum) <> 0 Then error occured 
   If ReplaceTens(RomanNum) <> 0 Then error occured
   If ReplaceHundreds(RomanNum) <> 0 Then error occured
   If ReplaceThousands(RomanNum) <> 0 Then error occured
   'you will need to correct the leading + sign in the final expression
 
   If PlacesCheck(RomanNum) <> 0 Then error occured
   'You will reuse ExpressionToArray() in placescheck() to 
   'get an array to check by iteration to ensure that
   'the decimal values progress in order from thousands to ones
 
   romanNum = EvaluateExpression(RomanNum) & ""
 
   RomanToDecimal = 0  'completed successfully
End Function
 
 
'Pseudocode for ones place, do the same for the other places
' note validity checks during conversion
Public Function ReplaceOnes(ByRef Expression As String) As Long
Dim IVcount As Long
Dim IXcount As Long
 
   ReplaceOnes = -1
   IVcount = CharCount("IV", Expression)
   IXcount = CharCount("IX", Expression)
 
   If IVcount > 0 and IXcount > 0 Then
      'error, IX and IV cannot exist at the same time    
   ElseIf IVcount > 1 Then
      'error, only one IV in a number
   ElseIf IXcount > 1
      'error only one instance of IX is valid
   ElseIf IVcount = 1  
      'notice no need to check IXcount = 0, 
      'it is implied cause first case already handles IVcount > 0 and IXcount > 0
      Expression = Replace(Expression, "IV", "+4")
      If CharCount("I", Expression) > 0 Or CharCount("V", Expression) > 0 Then
         'error, I's or V exist when IV already used
      End If 
   ElseIf IXcount = 1
      'almost same format as IVcount = 1, test I's and X
   ElseIf IVcount = 0 and IXcount = 0
      If CharCount("V", Expression) > 1 Then
         'error, only one V is valid
      Else
         Expression = Replace(Expression, "V", "+5")
      End If
 
      If CharCount("I", Expression) > 3 Then
         'error, only up to 3 I's valid
      Else
         Expression = Replace(Expression, "I", "+1")
      End If
   End If
 
   ReplaceOnes = 0 'completed with no errors
End Sub
 
Public Function EvaluateExporession()
Dim oSCRCNT As New ScriptControl
 
   'sorry have to go... but this will have only about 3 to 5 lines
   'anyone for the save??
End Function

And I mentioned the script control and the eval method. Thread starter, this is what you will use to perform arithmetic operations on your roman numerals.

You enter an expression: "X + VII"
You get an expression array and call romantodecimal:
Array("10","+","5 + 1 + 1") --> Array("10","+", "7") after romantodecimal call
RomanToDecimal also performs the Eval method of the script control to get the result of 5+1+1 = 7
You then perform another Eval on the final expression "10+7"

You will need to set the project reference of the script control
You will need to create a new instance of the object in EvaluateExpression()
you will need to set the lagnuage property of the object to "vbscript"
Then finally call the Eval method and get the result of your arithmetic expression.