The rules for writing Roman numerals allow for many ways of writing each number (see FAQ: Roman Numerals). However, there is always a "best" way of writing a particular number.
For example, the following represent all of the legitimate ways of writing the number sixteen:
IIIIIIIIIIIIIIII
VIIIIIIIIIII
VVIIIIII
XIIIIII
VVVI
XVI
The last example being considered the most efficient, as it uses the least number of numerals.
The 11K text file, roman.txt (right click and 'Save Link/Target As...'), contains one thousand numbers written in valid, but not necessarily minimal, Roman numerals; that is, they are arranged in descending units and obey the subtractive pair rule (see FAQ for the definitive rules for this problem).
Find the number of characters saved by writing each of these in their minimal form.
Note: You can assume that all the Roman numerals in the file contain no more than four consecutive identical units.
It turns out that the roman numbers in the provided data file are in the acceptable Roman form (descending order of size). So, the only thing we need to do is factor in the subtractive combinations.
Download the data file and open it in Excel. The data will be in column A. In cell B1 enter the formula =SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE( A1, "VIIII", "IX"), "IIII", "IV"), "LXXXX", "XC"), "XXXX", "XL"), "DCCCC", "CM"), "CCCC", "CD")
or formatted a little better for readability:
=SUBSTITUTE(
SUBSTITUTE(
SUBSTITUTE(
SUBSTITUTE(
SUBSTITUTE(
SUBSTITUTE( A1, "VIIII", "IX"),
"IIII", "IV"),
"LXXXX", "XC"),
"XXXX", "XL"),
"DCCCC", "CM"),
"CCCC", "CD")
Of course, if we plan to use the same complex formula over and over, it might be easier to use VBA to write and use a user defined function (UDF)
Public Function RomanSubtractive(ByVal Roman As String) As String
RomanSubtractive = Replace(Replace(Replace(Replace(Replace(Replace( _
Roman, "VIIII", "IX"), "IIII", "IV"), "LXXXX", "XC"), "XXXX", "XL"), _
"DCCCC", "CM"), "CCCC", "CD")
End Function
However you do it, copy the formula in B1 as far down column B as column A has data. Then, use the LEN function to calculate the lengths of the strings in column A and column B. Add the lengths in each column and compute the difference. That is your answer.
However, for the sake of completeness, the following RomanToDecimal and DecimalToRoman functions, together with their supporting routines convert any Roman number to an Arabic number and vice versa.
Option Explicit
Dim RDMap As Collection
Private Sub Initialize()
Static Initialized As Boolean
If Initialized Then Exit Sub
Initialized = True
Set RDMap = New Collection
RDMap.Add 1, "I"
RDMap.Add 5, "V"
RDMap.Add 10, "X"
RDMap.Add 50, "L"
RDMap.Add 100, "C"
RDMap.Add 500, "D"
RDMap.Add 1000, "M"
RDMap.Add "I", "1"
RDMap.Add "V", "5"
RDMap.Add "X", "10"
RDMap.Add "L", "50"
RDMap.Add "C", "100"
RDMap.Add "D", "500"
RDMap.Add "M", "1000"
End Sub
Private Function getNextChar(ByVal aStr As String, ByVal CurrPos As Integer) As String
If CurrPos = Len(aStr) Then getNextChar = "" Else getNextChar = Mid(aStr, CurrPos + 1, 1)
End Function
Private Function RomanCharVal(ByVal aChar As String) As Integer
On Error Resume Next
RomanCharVal = CInt(RDMap(aChar))
End Function
Public Function RomanToDecimal(ByVal Roman As String, _
Optional ByVal RestrictiveSubstraction As Boolean = True)
Initialize
Dim I As Integer, Rslt As Long
For I = 1 To Len(Roman)
Dim ThisChar As String, NextChar As String
ThisChar = Mid(Roman, I, 1)
NextChar = getNextChar(Roman, I)
Select Case ThisChar
Case "I":
Select Case NextChar
Case "I", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "V", "X": Rslt = Rslt - RomanCharVal(ThisChar)
Case "L", "C", "D", "M":
If RestrictiveSubstraction Then GoTo ErrXIT _
Else Rslt = Rslt - RomanCharVal(ThisChar)
Case Else: 'Invalid char; will be trapped on the next iteration
End Select
Case "V":
Select Case NextChar
Case "I", "V", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "X", "L", "C", "D", "M":
If RestrictiveSubstraction Then GoTo ErrXIT _
Else Rslt = Rslt - RomanCharVal(ThisChar)
Case Else:
End Select
Case "X":
Select Case NextChar
Case "I", "V", "X", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "L", "C": Rslt = Rslt - RomanCharVal(ThisChar)
Case "D", "M":
If RestrictiveSubstraction Then GoTo ErrXIT _
Else Rslt = Rslt - RomanCharVal(ThisChar)
Case Else:
End Select
Case "L":
Select Case NextChar
Case "I", "V", "X", "L", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "C", "D", "M":
If RestrictiveSubstraction Then GoTo ErrXIT _
Else Rslt = Rslt - RomanCharVal(ThisChar)
Case Else:
End Select
Case "C":
Select Case NextChar
Case "I", "V", "X", "L", "C", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "D", "M": Rslt = Rslt - RomanCharVal(ThisChar)
Case Else:
End Select
Case "D":
Select Case NextChar
Case "I", "V", "X", "L", "C", "D", "": Rslt = Rslt + RomanCharVal(ThisChar)
Case "M":
If RestrictiveSubstraction Then GoTo ErrXIT _
Else Rslt = Rslt - RomanCharVal(ThisChar)
Case Else:
End Select
Case "M":
Rslt = Rslt + RomanCharVal(ThisChar)
Case Else:
GoTo ErrXIT
End Select
Next I
RomanToDecimal = Rslt
Exit Function
ErrXIT:
RomanToDecimal = "#Err! Invalid character (" & ThisChar & ") at position " & I
End Function
Private Function getOneCharList(ByRef CurrVal As Long, ByVal RomanCode As String)
Dim RomanVal As Integer, NbrChar As Integer
On Error GoTo ErrXIT
RomanVal = RDMap(RomanCode)
On Error GoTo 0
NbrChar = CurrVal \ RomanVal
CurrVal = CurrVal - NbrChar * RomanVal
If NbrChar > 0 Then getOneCharList = String(NbrChar, RomanCode)
Exit Function
ErrXIT:
End Function
Public Function RomanSubtractive(ByVal Roman As String) As String
RomanSubtractive = Replace(Replace(Replace(Replace(Replace(Replace( _
Roman, "VIIII", "IX"), "IIII", "IV"), "LXXXX", "XC"), "XXXX", "XL"), _
"DCCCC", "CM"), "CCCC", "CD")
End Function
Public Function DecimalToRoman(ByVal DecVal As Long) As String
Initialize
DecimalToRoman = getOneCharList(DecVal, "M") & getOneCharList(DecVal, "D") _
& getOneCharList(DecVal, "C") & getOneCharList(DecVal, "L") _
& getOneCharList(DecVal, "X") & getOneCharList(DecVal, "V") _
& getOneCharList(DecVal, "I")
DecimalToRoman = RomanSubtractive(DecimalToRoman)
End Function