Project Euler Problem 89
You are on the Home/Other Tutorials/Project Euler/Problem 89 page
Google
Web This Site

Project Euler - Problem 89

More about Project Euler.

Problem description

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.

 

Solution

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