# Euler Problem 89

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

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

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 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
oman.txt”

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
Loop
Close #1

For k = 1 To 1000
Value = 0
TEMPstr = Romans(k)
L1 = Len(TEMPstr)
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”
Delta = Delta – I
Else
Delta = Delta + I
End If
Case “V”
Delta = Delta – V
Else
Delta = Delta + V
End If
Case “X”
Delta = Delta – X
Else
Delta = Delta + X
End If
Case “L”
Delta = Delta – L
Else
Delta = Delta + L
End If
Case “C”
Delta = Delta – C
Else
Delta = Delta + C
End If
Case “D”
Delta = Delta – D
Else
Delta = Delta + D
End If
Case “M”
Delta = Delta + M
End Select
Value = Value + Delta   ‘Value will be the decimal equivalent
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 &amp; “M”
Next j
For j = 1 To numDs
TEMPstr = TEMPstr &amp; “D”
Next j
For j = 1 To numCs
TEMPstr = TEMPstr &amp; “C”
Next j
For j = 1 To numLs
TEMPstr = TEMPstr &amp; “L”
Next j
For j = 1 To numXs
TEMPstr = TEMPstr &amp; “X”
Next j
For j = 1 To numVs
TEMPstr = TEMPstr &amp; “V”
Next j
For j = 1 To numIs
TEMPstr = TEMPstr &amp; “I”
Next j
‘TEMPstr now in simplest form
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)

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.

…mrt

Posted in Uncategorized

## 5 thoughts on “Euler Problem 89”

1. Doug Jenkins says:

“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. Debra Dalgleish says:

When I mentioned the 3999 limit in an article on the ROMAN function, Tim Mayes commented “According to Wikipedia, large numbers (4000 and above) are usually written with a line on top to indicate multiplication by 1000. I guess it was easier to just cut it off at 3999 than to try to implement that.”

3. Hans Schraven says:

If speed and elegance do matter:

Open text For Input As #1
Romans=split(Input(LOF(1)),#1),vbcr &amp; chr(10))
Close #1
4. Hans Schraven says:

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
oman.txt”
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:  “ &amp; x &amp; ”   Time:  “ &amp; Timer – T
End Sub
5. Michael says:

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… ;-)

…mrt

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