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

Euler 89 asks:

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

The tasks are 5:

- Read the file
- Parse the Numerals to find the decimal value
- Rebuild the Numerals in simplest form
- Apply the complete subtractive rules
- 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 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

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)

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

Else

Delta = Delta + I

End If

Case “V”

If LastAdd > V Then

Delta = Delta – V

Else

Delta = Delta + V

End If

Case “X”

If LastAdd > X Then

Delta = Delta – X

Else

Delta = Delta + X

End If

Case “L”

If LastAdd > L Then

Delta = Delta – L

Else

Delta = Delta + L

End If

Case “C”

If LastAdd > C Then

Delta = Delta – C

Else

Delta = Delta + C

End If

Case “D”

If LastAdd > D Then

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

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.

…mrt

“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?

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

http://blog.contextures.com/archives/2008/12/02/be-a-roman/#comments

If speed and elegance do matter:

Romans=split(Input(LOF(1)),#1),vbcr & chr(10))

Close #1

There are only 6 possibilities to shorten Roman numerals.

As the file roman.txt contains 1 textstring it can be treated as such.

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: “ & x & ” Time: “ & Timer – T

End Sub

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