Euler Problem 76

Euler Problem 76 asks:

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?

This is a Euler Partition problem, one of at least 4 in the problem set (Nos. 31, 77, and 78 are also.) I didn’t now that when I solved #31. I came across Euler partitions as a hint to solving problem #76.

Two things I’ve learned about Project Euler:

  1. If Leonhard Euler was involved with it, Project Euler is involved with it, and
  2. There’s probably a PhD in a mathematics department somewhere that has a monograph on the topic

Problem 76 is right out of that playbook. The paper Playing with Partitions on the Computer from the mathematics server of Temple University is exactly on point. In fact, if you catch the hint in the document, the answer is right there in the back. No computer required. The authors provide a Section 4, A Basic Program to Generate Partitions.

This is my VBA translation of the authors’ algorithms. The number of partitions for zero, P(0), is defined as 1, there being only one way to take zero, and the number of partitions for any negative number is zero, so when the indexing reaches for a negative partition, we can stop the loop. The partitions for later numbers grow from the partitions of earlier numbers by pentagonal numbers (as F below). That’s what Euler discovered. It’s covered in the reference.

The code names that tune in “zero” notes, err seconds, per the timer.

Sub Problem_076()
 
   Dim P(0 To 100) As Long
   Dim N As Long
   Dim K As Long, F As Long
   Dim Sign As Long
   Dim Answer As Long, T As Single
   
   T = Timer
 
   P(0) = 1 ‘ defined
  For N = 1 To 100
      Sign = 1
      P(N) = 0
      For K = 1 To 100
         F = K * (3 * K – 1) / 2
         If F > N Then Exit For ‘ P(N-F) = 0
        P(N) = P(N) + Sign * P(N – F)
         F = K * (3 * K + 1) / 2
         If F > N Then Exit For ‘ P(N-F) = 0
        P(N) = P(N) + Sign * P(N – F)
         Sign = -Sign
      Next K
   Next N
 
   Answer = P(100) – 1
 
   Debug.Print Answer; ”  Time:”; Timer – T
End Sub

The usual angle brackets substitutions are in the above. This code, slightly modified, will directly solve #78. You’ll need to make the partition reachback (K) bigger, and look for a different kind of endpoint. The number of partitions corresponding to the answer of #78 is a 257 digit number.

Euler partitions occasionally make the news. They’ll explain them better than I can, for sure.

Now, what I can’t figure out is what to change when the increments are prime numbers (as in #77), rather than unitary. I’d think it should be N, or the Loop step, but I haven’t got it yet.

…mrt

Posted in Uncategorized

18 thoughts on “Euler Problem 76

  1. Euler was a genius.

    I think we used the same reference, Michael. Your code is more concise and readable than mine, so I’m not going to embarrass myself by posting mine. I’m interested in seeing how that code can be adapted to solving #77 with prime numbers.

    In the comment thread for Euler Problem 124, we had a discussion about how Problem #77 (prime partition) seemed similar to Problem #31 (investigating the number of ways to make change). Michael posted a very nice recursive solution to #31, which I’ve managed to adapt to work with prime numbers for #77. Here’s the code with the usual angle bracket adjustments.

    Sub Euler77()
    ‘This is based on a solution to #31 found in the PE forums
       Dim MaxNum As Long, StartTime As Single
       
        StartTime = Timer
        MaxNum = 1
        Do
            MaxNum = MaxNum + 1
            ArrayOfPrimesCounter = 0
            Call GetListOfPrimes(MaxNum)
        Loop Until findposs(MaxNum, 1) &GT 5000
        Debug.Print MaxNum, Timer – StartTime
    End Sub

    Function findposs(money As Long, maxcoin As Long) As Long
        Dim sum As Long, i As Long
           
        sum = 0
        For i = maxcoin To ArrayOfPrimesCounter
           If money – ArrayOfPrimes(i) = 0 Then sum = sum + 1
           If money – ArrayOfPrimes(i) &GT 0 Then sum = sum + findposs(money – ArrayOfPrimes(i), i)
        Next i
        findposs = sum
    End Function

    My routines for finding / listing prime numbers are not shown here, but ArrayOfPrimesCounter is the number of primes less than or equal to the limit, and they are stored in the array ArrayOfPrimes (1-based). It would be more efficient if I didn’t get a new list of primes every time through the Do loop, but the limit is quite small and the Sieve of Eratosthenes is extremely fast. The added coding time wasn’t worth the slightly decreased execution time. The above code runs in under a second on my machine. I may be getting ahead of myself here, but I wonder if this can be adapted to #249?

    -Josh

  2. Hi Josh –

    Thank you. It frustrates me when the Euler examples from the forum can really only be deciphered by the author, and in a month, I’d bet he can’t do it.

    And now it’s me doing something wrong. My (new) sieve is quick enough. With a limit of 50 million, it found and counted 3 million primes in 17 seconds (problem 187). It does the ones here in a blink.

    However, the recursion following your example takes 6 seconds. Don’t know why.

    …mrt

  3. Hi Michael,

    I share your frustrations with the forums. Being neither a mathematician nor a real computer programmer, my eyes tend to glaze over when reading some solutions. But every once in a while someone points you to Euler’s Partition Function and you wonder how your life was ever complete before.

    I’m consistently getting 0.6 – 0.7 seconds. It’s strange that it’s taking you much longer, since our timings on other problems are pretty similar. I use Longs for the primes array. I think my sieve is a bit faster than yours, but the limit is so low that it shouldn’t matter. Could the recursive part be slowing you down? I use XL2007. One option would be to add a second timer in the Main sub to cumulatively time all of the calls to the GetPrimes or findposs. This way you could at least see where the slowdown is. I’m curious to see the problem.

    -Josh

  4. Hi Josh –

    The recursion is definitely the problem. Timers around the other steps are zero. I put a global variable inside findposs that’s incremented by 1 every call. findposs is called 1207704 times!

    Whoa! and other words that start with W

    …mrt

  5. That W word stands for “I should know better” I wasn’t re-initializing the variable, and it just accumulated until I did a reset.

    Now it’s only is called 603,852 times ;-) Half the above, but repeatable.

    …mrt

  6. Michael,
    I was just composing a reply, telling you that my counter showed exactly half of your value, when I decided to refresh the page. I see you’ve gotten there already. Is your solution is still taking 6 seconds?

    -Josh

  7. Good morning, Josh –

    I think I’m as stripped as I can get. I essentially have a parallel structure to yours. Takes 3.4 seconds, 604K trips.

    About the best I can do I think.

    …mrt

  8. And good morning to you Michael,
    If you like, you can post / email me your code and I can try it out to see if the time discrepancy is related to different versions or some such. Or, you can move on.

    -Josh

  9. Hi Josh – FWIW

    Private PrimeCol As New Collection, Num As Long
    Sub Euler77()
       Dim MaxNum As Long, T As Single
       Dim Prime() As Boolean
     
       T = Timer
       Num = 0
       
       If PrimeCol.Count  0 Then
          Do
             PrimeCol.Remove (PrimeCol.Count)
          Loop Until PrimeCol.Count = 0
       End If
     
       MaxNum = 1
       Do
          MaxNum = MaxNum + 1
          ReDim Prime(1 To MaxNum) As Boolean
          Sift Sieve:=Prime
          If Prime(MaxNum) Then PrimeCol.Add Item:=MaxNum, Key:=CStr(MaxNum)
       Loop Until findsum(MaxNum, 1) > 5000
     
       Debug.Print MaxNum, Timer – T, Num
    End Sub
    Function findsum(money As Long, maxcoin As Long) As Long
       Dim sum As Long, i As Long
       Num = Num + 1
       sum = 0
       
       If maxcoin = PrimeCol.Count Then
          findsum = 1
          Exit Function
       End If
     
       For i = maxcoin To PrimeCol.Count
          If money – PrimeCol(i) = 0 Then sum = sum + 1
          If money – PrimeCol(i) > 0 Then sum = sum + findsum(money – PrimeCol(i), i)
       Next i
         
       findsum = sum
     
    End Function
    Function Sift(ByRef Sieve As Variant) As Variant
    ‘Sets Sieve(N) TRUE if prime
      Dim Limit As Long, BreakPT As Long
       Dim N As Long, M As Long, Count As Long
       
       Limit = UBound(Sieve)
       BreakPT = Int(Sqr(Limit))
       
       Sieve(1) = False
       Sieve(2) = True
           
       For N = 3 To Limit
          Sieve(N) = True
          If N Mod 2 = 0 Then Sieve(N) = False
       Next N
     
       For N = 3 To BreakPT Step 2
          If Sieve(N) Then
             For M = N * N To Limit Step 2 * N
                Sieve(M) = False
             Next M
          End If
       Next N
     
    End Function

    …mrt

  10. Hi Michael,
    Your code as posted takes about 6 seconds on my machine. I think I found the slowdown though – it’s the collection object. You’re only adding a few numbers to the collection, but by my count you’re extracting a number about 15 million times! For comparison I decided to get a list of the first few primes, store them in a collection, and then time how long it took to extract the same number 15 million times. I then stored the numbers as Longs in an array and timed how long it took to extract the same number 15 million times.
    Extract from collection: 3.6 seconds
    Extract from array: 0.5 seconds

    I modified your code to use an array rather than a collection and consistently got around 1 second. Hope this helps.

    -Josh

  11. Josh –

    Oh. Haven’t got the hang of it yet. My old code did run in 3.5 seconds. New arrayed code in 1.5. Something eludes my grasp here about ref to arrays. No globals any more.

    Sub Euler77()
       Dim MaxNum As Long, T As Single, i As Long, j As Long
       Dim Item As Long, Key As String, T1 As Single
       Dim Prime() As Boolean, PrimeArr(1 To 100) As Long
     
       T = Timer
     
       MaxNum = 1
       j = 0
       Do
          MaxNum = MaxNum + 1
          ReDim Prime(1 To MaxNum) As Boolean
          Sift Sieve:=Prime
          If Prime(MaxNum) Then
             j = j + 1
             PrimeArr(j) = MaxNum
          End If
       Loop Until findsum(MaxNum, 1, PrimeArr, j) > 5000
     
       Debug.Print MaxNum, Timer – T
    End Sub
    Function findsum(money As Long, maxcoin As Long, ByRef PrimeArr As Variant, j As Long) As Long
       Dim sum As Long, i As Long
     
       sum = 0
       
       If maxcoin = j Then
          findsum = 1
          Exit Function
       End If
     
       For i = maxcoin To j
          If money – PrimeArr(i) = 0 Then sum = sum + 1
          If money – PrimeArr(i) > 0 Then sum = sum + findsum(money – PrimeArr(i), i, PrimeArr, j)
       Next i
       
       findsum = sum
    End Function

    Same number of trips. No surprise there. j is the pointer to the last added prime. Was the collection count before.

    …mrt

  12. Michael,
    Your new code runs in 2.5 seconds for me. You must have a fast machine indeed!

    Suggestion: in the findsum function argument list, change the line from
    ByRef PrimeArr as Variant
    to
    ByRef PrimeArr() as Long

    Cuts the time to ~0.75 seconds for me.

    I try not to use globals much, but I make an exception for the primes array. They get used and passed between procedures so often that it’s easier for me to just let them go everywhere on their own.

    -Josh

  13. Hi Josh –

    Victory! 0.5625 seconds. Thank you.

    Per the System Properties/General: Intel(R) Core(TM)2 Duo CPU E8400 @3.00GHz 1.97GHz, 3.46GB of RAM

    It’s my tech refresh hot rod. Now on to the next one.

    …mrt

  14. Michael,
    Glad to help.

    That’s a pretty sweet machine for sure.

    What problem are you working on next? This latest collection of partition problems, especially #76, is one of the reasons I love PE. I can often hack my way to a solution, sometimes in Euler time and sometimes not, and then visit the forums and get blown away by something I’ve never heard of before. The flip side of this is that many times it seems that if you don’t know the right algorithm / equation, the problem is nearly impossible to solve. #233 for example seems to fall in this class. It can be really frustrating. I think I’ve found the right approach, but it took quite a while to find it and even longer to understand how to use it. Now, I just need to figure out how to program it…

    -Josh

  15. Hi Josh –

    I just did 131 exactly that way. Double ugly. Then in the forum found a 4-liner solution once the arrays are populated. Some times I have the math insight, but most often not. For 131 I was sort of half-math ;-)

    Not sure what’s next…I sort of do them in difficulty order picking one that I think understand on page 3 when the problems are sorted in ascending order of difficulty.

    #205 goes up Saturday. I found an approach that took me from 385 seconds to about 0.6 seconds.

    …mrt

  16. Hi Michael,

    Can you explain what the line of code in your post on August 05, 2009 at 2:26 pm does?

    It is inside your prime sieve.

    Sift Sieve:=Prime

    I have not seen/used this before.

    -Tim

  17. Hi Tim –

    Prime is an array of Booleans. In the above, it keeps getting Re-Dimmed to a larger array.

    Sift() is a functional implementation (it’s above) of the Sieve of Eratosthenes (see http://en.wikipedia.org/wiki/Sieve_of_Eratosthenes). It very quickly assigns TRUE to the boolean if the index is a prime number. So you can find if a number is prime by “If Prime(n)” returns true. To make this work, you have to have set the boundaries above the n you are interested in.

    So my “Sift Sieve:=Prime” is a VBA play on words (“sifting the prime sieve” )to create the proper boolean array. Works very well. It can be made faster by being TRUE if a number is NOT PRIME, but I like the logic better this way.

    …mrt

Leave a Reply

Your email address will not be published. Required fields are marked *