Author: Michael

Euler Problem 55

Posted on by Michael

Problem 55 asks:

‘If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.
‘
‘Not all numbers produce palindromes so quickly. For example,
‘
‘349 + 943 = 1292,
‘1292 + 2921 = 4213
‘4213 + 3124 = 7337
‘
‘That is, 349 took three iterations to arrive at a palindrome.
‘
‘Although no one has proved it yet, it is thought that some numbers, like
‘196, never produce a palindrome. A number that never forms a palindrome
‘through the reverse and add process is called a Lychrel number. Due to the
‘theoretical nature of these numbers, and for the purpose of this problem,
‘we shall assume that a number is Lychrel until proven otherwise. In addition
‘you are given that for every number below ten-thousand, it will either
‘(i) become a palindrome in less than fifty iterations, or, (ii) no one, with
‘all the computing power that exists, has managed so far to map it to a
‘palindrome. In fact, 10677 is the first number to be shown to require over
‘fifty iterations before producing a palindrome:
‘4668731596684224866951378664 (53 iterations, 28-digits).
‘
‘Surprisingly, there are palindromic numbers that are themselves Lychrel
‘numbers; the first example is 4994.
‘
‘How many Lychrel numbers are there below ten-thousand?
‘
‘NOTE: Wording was modified slightly on 24 April 2007 to emphasise
‘the theoretical nature of Lychrel numbers.

Euler problems should calculate under a minute. This one takes about 1.3 seconds.
Here is my code:

Option Explicit
Option Base 1
Sub Problem_055()
 
   Dim i       As Long
   Dim j       As Long
   Dim T       As Single
   Dim n       As String
   Dim n_rev   As String
   Dim num     As String
   Dim Answer  As Long
   Dim Max     As Long
   Dim Last    As Long
   Dim IsTest  As Boolean
   Dim Series(5) As String
 
   T = Timer ‘start timing
   IsTest = True
   If IsTest Then ‘to test the example cases
      Max = 5
      Last = 53
      Series(1) = “47”
      Series(2) = “196”   ‘Lychrel
      Series(3) = “349”
      Series(4) = “4994”   ‘Lychrel
      Series(5) = “10677”
   Else
      Max = 9999    ‘ less than 10,000
      Last = 50
  end if
 
 For j = 1 To Max
      If IsTest Then
         n = Series(j)
      Else
         n = CStr(j)
      End If
      For i = 1 To last ‘to test 10677
         n_rev = StrReverse(n)
         num = AddAsStrings(n, n_rev)
         If num = StrReverse(num) Then ‘not a Lychrel number
            Exit For
         End If
         n = num
         If i = last Then
            Answer = Answer + 1
         End If
      Next i
  Next j
 
   Debug.Print Answer; ”  Time:”; Timer – T
 
End Sub

It uses the AddAsStrings() function from Problem 16. It exits the loop if the addition is equal to its reverse.

Of course, the real question, is why anybody cares about Lychrel numbers, and who would make them their life’s work ;-)

…mrt

Euler Problem 31

Posted on by Michael

Euler Problem 31 states:

‘In England the currency is made up of pound, £, and pence, p, and there are
‘eight coins in general circulation:
‘
‘    1p, 2p, 5p, 10p, 20p, 50p, £1 (100p) and £2 (200p).
‘
‘It is possible to make £2 in the following way:
‘
‘    1×£1 + 1×50p + 2×20p + 1×5p + 1×2p + 3×1p
‘
‘How many different ways can £2 be made using any number of coins?

Over in the Euler Problem 16 thread, dbb provided his answer. This is dbb’s code, copied from there, with 8 loops for eight coins:

Sub P31()
 
Dim P1 As Long, P2 As Long, P5 As Long, P10 As Long, P20 As Long
Dim P50 As Long, P100 As Long, P200 As Long
Dim n1 As Long, n2 As Long, n5 As Long, n10 As Long, n20 As Long
Dim n50 As Long, n100 As Long, n200 As Long
Dim n As Long
 
For P1 = 0 To 200 Step 1
    n1 = P1
    For P2 = 0 To 200 – n1 Step 2
        n2 = n1 + P2
        For P5 = 0 To 200 – n2 Step 5
            n5 = n2 + P5
            For P10 = 0 To 200 – n5 Step 10
                n10 = n5 + P10
                For P20 = 0 To 200 – n10 Step 20
                    n20 = n10 + P20
                    For P50 = 0 To 200 – n20 Step 50
                        n50 = n20 + P50
                        For P100 = 0 To 200 – n50 Step 100
                            n100 = n50 + P100
                            For P200 = 0 To 200 – n100 Step 200
                                If n100 + P200 = 200 Then
                                     n = n + 1
                                End If
                            Next P200
                        Next P100
                    Next P50
                Next P20
            Next P10
        Next P5
    Next P2
Next P1
Debug.Print n
 
End Sub

It runs in a second and a half on my machine. Problem 76 looks very similar.

‘It is possible to write five as a sum in exactly six different ways:
‘
‘4 + 1
‘3 + 2
‘3 + 1 + 1
‘2 + 2 + 1
‘2 + 1 + 1 + 1
‘1 + 1 + 1 + 1 + 1
‘
‘How many different ways can one hundred be written as a sum of at least
‘two positive integers?

Does that mean 100 loops are required?

…mrt

Euler Problem 16

Posted on by Michael

Hello All –

While Dick and company do the heavy lifting around here writing about VBA Frameworks, I asked if I could contribute about lighter fare, specifically the Project Euler Challenges. I am a systems engineer by trade, and use Excel as a tool to manage requirements. I confessed to Dick I have probably never used an accounting-specific Excel function, though I’ve been using Excel since v1.5 (yep…that old).

Project Euler indicates that all the challenges can be computed in less than one minute of computer time. Once you find a right answer, it’s like a password to review the thoughts, code, and comments of others who solved the problem before you. It’s disconcerting to read from a 14-year-old coder who solved the problem in just a few lines of Haskell (what’s that?). Nobody seems to be doing the problems in VBA, so I asked Dick if I could start conversations about how one might. One thing I won’t post is the answers–that’s a password you’ll at least have to have Excel to get. And there are more than a few that I’ve attempted that I’m stuck on, and then there are the ones that I don’t know how to start coding, and still others that I don’t understand the mathematics. Never-the-less…

Did you know that Excel can compute 2^1000 in four tenths of a second?
I didn’t either until I attempted Project Euler Problem 16 which states:

2^15 = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.

What is the sum of the digits of the number 2^1000?

There are two general tasks:

  1. Time the calculation
  2. Reproduce the example

and two specific tasks:

  1. Compute 2 to the 1000
  2. Calculate the sum of the digits

Here is my code:

Option Explicit
Option Base 1
Sub Problem_016()
       Dim exp     As Long
       Dim i       As Long
       Dim j       As Long
       Dim Answer  As Long
       Dim M1      As String
       Dim M2      As String
       Dim T       As Single
       Dim IsTest  As Boolean
 
       T = Timer   ‘starts timing    
      IsTest = False
       If IsTest Then  ‘to reproduce the test case
             exp = 15
       Else
             exp = 1000
       End If
 
       M1 = “2”
       For i = 2 To exp ‘calculates 2^exp
            M2 = AddAsStrings(M1, M1)
            M1 = M2
       Next i
 
       For i = 1 To Len(M2) ‘loops the length of 2^exp to sum digits
             Answer = Answer + CLng(Mid(M2, i, 1))
       Next i
 
      Debug.Print Answer; ”  Time:”; Timer – T; M2
 
End Sub

And by the way, 2^1000 is precisely:
10715086071862673209484250490600018105614048117055336074437503883703510
51124936122493198378815695858127594672917553146825187145285692314043598
45775746985748039345677748242309854210746050623711418779541821530464749
83581941267398767559165543946077062914571196477686542167660429831652624
386837205668069376

The key part is the AddAsStrings() function. It does addition the way you learned it–starting from the right and carrying to columns on the left.

Function AddAsStrings(Adder1 As String, Adder2 As String) As String
         
    Dim Sum     As Long
    Dim Carry   As Long
    Dim C       As Long
    Dim Answer  As String
 
    If Len(Adder1) > Len(Adder2) Then
         For C = 1 To Len(Adder1) – Len(Adder2)
               Adder2 = “0” & Adder2
         Next C
    ElseIf Len(Adder2) > Len(Adder1) Then
         For C = 1 To Len(Adder2) – Len(Adder1)
               Adder1 = “0” & Adder1
         Next C
    End If
 
    For C = Len(Adder1) To 1 Step -1        
          Sum = Carry + CLng(Mid(Adder1, C, 1))
          Sum = Sum + CLng(Mid(Adder2, C, 1))
          Carry = Int(Sum / 10)
          If C  <> 1 Then
                Answer = CStr(Sum Mod 10) & Answer
          Else
                Answer = CStr(Sum) & Answer
          End If
    Next C
 
    AddAsStrings = Answer
 
End Function

AddAsStrings() does well on Fibonacci numbers, simple multiplication (including squaring), and factorials. It doesn’t do as well on cubes and higher powers. It becomes loops inside loops. It works on powers of 2 because all we do is double and redouble…

You’ve seen me around here as both Michael and …mrt. For whatever it helps, I’m pleased to contribute.