Euler Problem 89

What to do on a snowy night? No, not that! How about solving Euler Problem 89?

Euler 89 asks:

‘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


‘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.

The tasks are 5:

  1. Read the file
  2. Parse the Numerals to find the decimal value
  3. Rebuild the Numerals in simplest form
  4. Apply the complete subtractive rules
  5. Use a running total to count keystrokes saved (differences in lengths)

I parsed each numeral from right to left, checking against what was the last operation to determine if the character in question represented an increase or decrease, since the basic rules were followed. Ran in 15 ms. Fast enough. Here’s the code.

Option Explicit
Option Base 1
Sub Problem_089C()
   Const I     As Long = 1
   Const V     As Long = 5
   Const X     As Long = 10
   Const L     As Long = 50
   Const C     As Long = 100
   Const D     As Long = 500
   Const M     As Long = 1000
   Dim T       As Single
   Dim Value   As Long
   Dim Answer  As Long
   Dim LastAdd As Long
   Dim Delta   As Long
   Dim TESTstr As String
   Dim TEMPstr As String
   Dim TEMPlng As Long
   Dim j       As Long
   Dim k       As Long
   Dim Romans(1000) As String
   Dim L1      As Long
   Dim L2      As Long
   Dim numIs   As Long
   Dim numVs   As Long
   Dim numXs   As Long
   Dim numLs   As Long
   Dim numCs   As Long
   Dim numDs   As Long
   Dim numMs   As Long
   Const text  As String = “C:DownloadsEuler

   T = Timer
   j = 1
   Open text For Input As #1   ‘1000 lines–Task 1
  Do While Not EOF(1)
      Line Input #1, Romans(j)
      j = j + 1
   Close #1
   For k = 1 To 1000
      Value = 0
      TEMPstr = Romans(k)
      L1 = Len(TEMPstr)
      LastAdd = 0   ‘to capture what was last addition
     For j = Len(TEMPstr) To 1 Step -1   ‘parsing right to left–Task 2
        Delta = 0   ‘what to add
        TESTstr = Mid(TEMPstr, j, 1)
         Select Case TESTstr
            Case “I”
               If LastAdd > I Then
                  Delta = Delta – I
                  Delta = Delta + I
               End If
            Case “V”
               If LastAdd > V Then
                  Delta = Delta – V
                  Delta = Delta + V
               End If
            Case “X”
               If LastAdd > X Then
                  Delta = Delta – X
                  Delta = Delta + X
               End If
            Case “L”
               If LastAdd > L Then
                  Delta = Delta – L
                  Delta = Delta + L
               End If
            Case “C”
               If LastAdd > C Then
                  Delta = Delta – C
                  Delta = Delta + C
               End If
            Case “D”
               If LastAdd > D Then
                  Delta = Delta – D
                  Delta = Delta + D
               End If
            Case “M”
               Delta = Delta + M
         End Select
         Value = Value + Delta   ‘Value will be the decimal equivalent
        LastAdd = Delta   ‘Delta captured
     Next j   ‘numeral is parsed

      TEMPstr = “”
      TEMPlng = Value   ‘taking Value and rebuilding it in simplest Roman form–Task 3
     numMs = Int(TEMPlng / M)   ‘counting 1000’s
     TEMPlng = TEMPlng – numMs * M
      numDs = Int(TEMPlng / D)   ‘counting 500’s
     TEMPlng = TEMPlng – numDs * D
      numCs = Int(TEMPlng / C)   ‘counting 100’s
     TEMPlng = TEMPlng – numCs * C
      numLs = Int(TEMPlng / L)   ‘counting 50’s
     TEMPlng = TEMPlng – numLs * L
      numXs = Int(TEMPlng / X)   ‘counting 10’s
     TEMPlng = TEMPlng – numXs * X
      numVs = Int(TEMPlng / V)   ‘counting 5’s
     TEMPlng = TEMPlng – numVs * V
      numIs = TEMPlng   ‘1’s are what’s left
     For j = 1 To numMs
         TEMPstr = TEMPstr & “M”
      Next j
      For j = 1 To numDs
         TEMPstr = TEMPstr & “D”
      Next j
      For j = 1 To numCs
         TEMPstr = TEMPstr & “C”
      Next j
      For j = 1 To numLs
         TEMPstr = TEMPstr & “L”
      Next j
      For j = 1 To numXs
         TEMPstr = TEMPstr & “X”
      Next j
      For j = 1 To numVs
         TEMPstr = TEMPstr & “V”
      Next j
      For j = 1 To numIs
         TEMPstr = TEMPstr & “I”
      Next j
      ‘TEMPstr now in simplest form
     ‘applying subtractive rules–Task 4
     TEMPstr = Replace(TEMPstr, “MCCCC”, “MCD”)
      TEMPstr = Replace(TEMPstr, “DCCCC”, “CM”)
      TEMPstr = Replace(TEMPstr, “CCCC”, “CD”)
      TEMPstr = Replace(TEMPstr, “CXXXX”, “CXL”)
      TEMPstr = Replace(TEMPstr, “LXXXX”, “XC”)
      TEMPstr = Replace(TEMPstr, “XXXX”, “XL”)
      TEMPstr = Replace(TEMPstr, “LIIII”, “LIV”)
      TEMPstr = Replace(TEMPstr, “XIIII”, “XIV”)
      TEMPstr = Replace(TEMPstr, “VIIII”, “IX”)
      TEMPstr = Replace(TEMPstr, “IIII”, “IV”)
      L2 = Len(TEMPstr)
      Answer = Answer + L1 – L2   ‘L1 – L2 is keystokes saved per numeral–Task 5
  Next k
   Debug.Print Answer; ”  Time:”; Timer – T
End Sub

Those are all “greater thans” and ampersands. I wanted to use the ROMAN() function, but it breaks a some ridiculously low number like 3999. This one took a while. Version 089B stuffed a spreadsheet as a prototype with the value and the rebuilt number, and then deciphered the rebuild to make sure the going in and going out were the same. It also showed where the subtractive rules as implemented might screw up…and cost key strokes. V089A tried to parse in pairs. Don’t go that way…that’s what ate up the day.


Posted in Uncategorized

5 thoughts on “Euler Problem 89

  1. “but it breaks a some ridiculously low number like 3999?

    This seems to be a Microsoft policy. Numerous Excel functions (factorial and decimal to binary spring to mind) fail to work at a ridiculously low number.

    Since it is easy to write these things so they would work at a much higher number I conclude that there must be some Microsoft policy to cripple a proportion of the lesser used functions.

    Why would they do that though?

    So they have something to upgrade in the next release?

  2. If speed and elegance do matter:

      Open text For Input As #1
      Romans=split(Input(LOF(1)),#1),vbcr & chr(10))
      Close #1
  3. There are only 6 possibilities to shorten Roman numerals.
    As the file roman.txt contains 1 textstring it can be treated as such.

    Sub Euler89()
      Dim x As Long, T As Long, c0 As String
      T = Timer
      Open “E:OF
    For Input As #1
        c0 = Input(LOF(1), #1)
        x = LOF(1) – Len(Replace(Replace(Replace(Replace(Replace(Replace(c0, “VIIII”, “IX”), “IIII”, “IV”), “LXXXX”, “XC”), “XXXX”, “XL”), “DCCCC”, “CM”), “CCCC”, “CD”))
      Close #1
      Debug.Print “Result:  “ & x & ”   Time:  “ & Timer – T
    End Sub
  4. Hans –

    Yep. Reading the comments, there is at least one person who solved it in MSWord. He opened the file, looked at the Statistics property for a character count, made the replacements, and got a new character count.

    He told Euler the difference. Now I don’t give that guy any points for elegance. He’s the wiseguy I used to sit behind… ;-)


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.