Project Euler 76 - List All Partitions For a Given Number

Here is how Project Euler Problem #76 sounds like: "How many different ways can one hundred be written as a sum of at least two positive integers?"

I've struggled to get it right for a couple of days, tried to solve in different ways and got mostly the same results for small numbers (those that are easy to check). I ended up with an algorithm that lists all partitions for a given number in alphabetical order, descending (starting from "N-1 + 1"). Written in VB.NET:

Dim ub As Integer = 6
Dim wayCount As Integer = 0
For n = ub - 1 To 1 Step -1
  'init value array (first combination)
  Dim s As New List(Of Integer)
  For m = 1 To ub \ n : s.Add(n) : Next
  Dim b As Integer = ub Mod n
  If b <> 0 Then s.Add(b)

  'from where to start decrementing
  Dim k As Integer = s.Count - 1
  While k > 0 And s(k) = 1 : k -= 1 : End While

  Do
    wayCount += 1 : Console.WriteLine(String.Join(" + ", s) & " = " & s.Sum)
    If s(k) = 1 Then k -= 1
    If k = -1 Then Exit Do
    s(k) -= 1
    s.Add(1)
  Loop While k >= 1
Next

Console.WriteLine("count=" & wayCount)

The code works for numbers 1-6 inclusive and starts failing for N=7, with 1 combination missed. For N=8 it misses 2 (19 instead of 21). For N=100 the answer is 4576, which is several orders of magnitude less than required. Clearly, 开发者_开发问答I am missing some very important detail.

If you don't have time or means to compile and run the above code, here is the output (N=7):

6 + 1 = 7
5 + 2 = 7
5 + 1 + 1 = 7
4 + 3 = 7
4 + 2 + 1 = 7
4 + 1 + 1 + 1 = 7
3 + 3 + 1 = 7
3 + 2 + 1 + 1 = 7
3 + 1 + 1 + 1 + 1 = 7
2 + 2 + 2 + 1 = 7
2 + 2 + 1 + 1 + 1 = 7
2 + 1 + 1 + 1 + 1 + 1 = 7
1 + 1 + 1 + 1 + 1 + 1 + 1 = 7
count=13

I've studied these links:

(ProjectEuler) Sum Combinations - provides a mathematical solution, which does not list all combinations

Generating the partitions of a number - is in python, which I cannot read/run/understand.

Any help would be much appreciated, thanks in advance!

You say, "The code works for numbers 1-6 inclusive and starts failing for N=7, with 1 combination missed." You should step through your code one line at a time for N=7, either in a debugger or by hand. By seeing in detail exactly what your code is doing you will be able to see where it misses a combination.

There is a fairly accurate closed-form solution to this problem, believe it or not.

Hardy and Ramanujan's formula:

                    e^(PI sqrt(2n/3))
            p(n) ~   -----------------
                        4n sqrt(3)

which gets closer as n->infinity. The mathematician Rademacher made an exact formula, but it isn't pretty. Here's a discussion.

I would recommend reading about it on Wikipedia and Mathworld here and here.

This is the MathOverflow discussion of the problem.

I'm not saying these are the best solutions to this problem. In fact for reasonably small values of n they're a waste of time, but it is interesting to see this solution as well as the more "computer-oriented" ones.

As promised, here is some code that does partitioning of N (stored in ub) using natural numbers up to N, but not including it. With slight modification, it should be able to partition by any function, including that with floating point output.

Basic idea is that for every value used in partitioning we are using coefficient bucket, which is a multiplier of that value. On every step we either charge the value to maximum available, move left or right, decrement current multiplier and test if we get to the sum. Once sum was successfully partitioned, wayCount is incremented and result is printed to the screen.

This might be a somewhat dirty implementation, but it works in a reasonable time even for the scope of the problem in question (under 5 minutes on my machine), generating several millions of partitions per second. Healthy criticism is always welcome!

Dim ub As Integer = 10
Dim availableIncrements(ub - 2) As Integer
Dim weightCoefficients(ub - 2) As Integer
For i = 0 To ub - 2
  availableIncrements(i) = ub - i - 1
  weightCoefficients(i) = -1 'indicates that enumeration has not started yet
Next
Dim wayCount As Integer = 0

Dim pos, sum As Integer
pos = 0 : sum = 0
Do
  If weightCoefficients(pos) = -1 Then
    'when we came here first, charge coefficient to maximum available
    weightCoefficients(pos) = (ub - sum) \ availableIncrements(pos)
  ElseIf weightCoefficients(pos) > 0 Then
    'regular cycle: decrease by one
    weightCoefficients(pos) -= 1
  Else
    'return to previous bucket
    If pos = 0 Then Exit Do
    pos -= 1
    Continue Do
  End If

  'calculate current sum
  sum = 0
  For k = 0 To pos
    sum += availableIncrements(k) * weightCoefficients(k)
  Next
  'found combination
  If sum = ub And weightCoefficients(pos) > 0 Then
    wayCount += 1

    'printing to screen, remove when expecting many combinations
    Dim printList As New List(Of Integer)
    For i = 0 To pos 'which number to print
      For k = 1 To weightCoefficients(i) 'how many times to print a number
        printList.Add(availableIncrements(i))
      Next
    Next
    Console.WriteLine(String.Join(" + ", printList))

    'if we were in the last bucket and we just partitioned the number,
    'no need to go down and check all lower coefficients, instead move one column back.
    If pos = UBound(availableIncrements) Then
      pos -= 1
      Continue Do
    End If
  End If

  If pos < UBound(availableIncrements) Then
    pos += 1
    weightCoefficients(pos) = -1 'prepare to charge
  End If

  'this is something to keep you busy (so you know it's not hanging)
  'uncomment for long enumerations
  'If wayCount Mod 100000 = 0 Then Console.WriteLine(wayCount)
Loop

Console.WriteLine("count=" & wayCount)