Tough Problem 2 (vba)

pgc01 · Jan 8, 2009

Hi again

Didn't have much luck with my formula problem. I'm trying again with a vba problem.

As I said in the previous thread, the idea is not to build a clear, easy to read and to maintain solution as in the Excel forum. The idea is to push the possibilities of the formulas/code to the limit, to learn in depth the power of the tools.

This problem is simpler than the last one, but it's still a challenge (I think) if you want to do it with just a few number of lines of code.

Tough Problem 2 (vba)

We know that if we sum some integers we get just 1 result, like 2+3+5=10. If we go the opposite direction, however, we can get lots of them. For example, there are 41 different sums with positive integers that total 10.

Question:

How many sums with positive integers total 50?

Rules:
- declare all variables
- less number of statements is better (not less number of lines, 2 statements in the same line are both counted)

Please if you think this is a very simple problem, wait 12 hours before posting the solution to allow for others to have some fun figuring it out.

schielrn · Jan 8, 2009

pgc01 said:
Tough Problem 2 (vba)

We know that if we sum some integers we get just 1 result, like 2+3+5=10. If we go the opposite direction, however, we can get lots of them. For example, there are 41 different sums with positive integers that total 10.

Are you counting 10+0 as part of the 41? Or just 10?

Greg Truby · Jan 8, 2009

Pedro,

In your example for 10: is 1+1+1+1+1+1+1+1+1+1 part of the solution set? Or each integer can be used only once?

pgc01 · Jan 8, 2009

How many sums with positive integers total 50?

Hi Schielrn, Greg

Thanks for posting.

Are you counting 10+0 as part of the 41? Or just 10?

Schielrn

No, as we are looking for a sum of positive integers, 10+0 doesn't qualify because 0 is not positive and 10 alone does not qualify because it's not a sum.

In your example for 10: is 1+1+1+1+1+1+1+1+1+1 part of the solution set? Or each integer can be used only once?

Greg

Each integer can be used as many times as you want. Since the addition is commutative each combination is only counted once (2+3+4,3+4+2,4+3+2, etc. are the same).

So that there are no doubts, here are the 41 sums of positive integers that total 10:

1+1+1+1+1+1+1+1+1+1
1+1+1+1+1+1+1+1+2
1+1+1+1+1+1+1+3
1+1+1+1+1+1+2+2
1+1+1+1+1+1+4
1+1+1+1+1+2+3
1+1+1+1+1+5
1+1+1+1+2+2+2
1+1+1+1+2+4
1+1+1+1+3+3
1+1+1+1+6
1+1+1+2+2+3
1+1+1+2+5
1+1+1+3+4
1+1+1+7
1+1+2+2+2+2
1+1+2+2+4
1+1+2+3+3
1+1+2+6
1+1+3+5
1+1+4+4
1+1+8
1+2+2+2+3
1+2+2+5
1+2+3+4
1+2+7
1+3+3+3
1+3+6
1+4+5
1+9
2+2+2+2+2
2+2+2+4
2+2+3+3
2+2+6
2+3+5
2+4+4
2+8
3+3+4
3+7
4+6
5+5

Cheers

Andrew Fergus · Jan 9, 2009

How about something like this:

Code:

Option Explicit

Dim ORow As Long
Const UpperLimit As Long = 20 'set to the number being checked

Sub SumOptions()

    Dim Values(UpperLimit) As Long, LC As Long
    
    ThisWorkbook.Sheets(1).Cells.Clear
    If UpperLimit < 2 Then Exit Sub
    For LC = UpperLimit - 1 To 1 Step -1
        Call Combos(LC, 0, 0, Values)
    Next LC
    MsgBox "Found " & ORow & " combinations.", vbInformation, "Finished!"

End Sub

Sub Combos(TestNum As Long, SoFar As Long, DigitsUsed As Long, ByRef Values() As Long)

    Dim Digits As Long, Bal As Long, LC As Long, L2 As Long
    
    Bal = SoFar + TestNum
    Digits = DigitsUsed + 1
    Values(Digits) = TestNum
    If Bal = UpperLimit Then
        ORow = ORow + 1
        For LC = 1 To Digits
            ThisWorkbook.Sheets(1).Cells(ORow, LC).Value = Values(LC)
        Next LC
        If Digits > 1 Then
            For LC = Digits To 2 Step -1
                If Values(LC) > 1 Then
                    Bal = 0
                    For L2 = 1 To LC - 1
                        Bal = Bal + Values(L2)
                    Next L2
                    Call Combos(Values(LC) - 1, Bal, LC - 1, Values)
                End If
            Next LC
        End If
    Else
        LC = UpperLimit - Bal
        If LC > TestNum Then LC = TestNum
        Call Combos(LC, Bal, Digits, Values)
    End If

End Sub

I could probably make it shorter by removing a couple of variables but that might only obfuscate the process!

ISSUE : If I try to do this for numbers 30 or larger I get a stack overflow error (nested too deeply?), but it works for values of 2 to 29 (set the 'UpperLimit' constant at the top of the code). I suspect it may crash for others at a different number depending on their PC RAM etc. By moving one of the loops out to the main procedure, I managed to get a higher limit than my previous test but I might now leave this for others....

Andrew

Oorang · Jan 9, 2009

-Delete

pgc01 · Jan 12, 2009

Hi Andrew

I tested your solution and it worked ok until 29 as you said. One thing curious, it crashed at 30 in both excel 2000 and excel 2007. Since we probably don't have the same memory/processor, etc., it's probably an internal error from the vba. I expected it to have a better stack/memory management now but apparently that's not the case.

Cheers

pgc01 · Jan 12, 2009

Hi all

Since no one else is posting, I'll post my first solution now. It's a solution using recursion, like Andrew's.

One thing interesting would be to solve it without recursion. The solutions based in recursion are usually smaller and easier to understand but you really don't need to use it. You can use just some loops instead.

Does anyone think it's interesting to try a new approach or should we move on to a next problem (easier, different?). Or just stop here?

This is a solution based in recursion:

Code:

Sub IntSum()
Dim lCount As Long
 
IntSum1 50, 0, 1, lCount
MsgBox "Total of sums equal to 50: " & lCount - 1
End Sub
 
Sub IntSum1(ByVal lTotal As Long, ByRef lSum As Long, ByVal lMin As Long, ByRef lCount As Long)
 
For lMin = lMin To lTotal - lSum
    If lSum + lMin = lTotal Then lCount = lCount + 1 Else IntSum1 lTotal, lSum + lMin, lMin, lCount
Next lMin
End Sub

schielrn · Jan 12, 2009

I love this idea and concept, but I have been swamped at work with year end and the start of our new accounting year. I started messign with the last one, but the only way I could think of solving it at the moment it was put out was to create as many loops for the number of numbers there could be and it could solve it, but would take forever to set it up. After looking at your code and trying it, I'm not sure I would have ever came up with that, but have definitely learned from it. Something a little easier would be nice, but not sure how much time I have lately because of the hectic work schedule and we finally close and move into our new house this week, so all my non-work time is working on the house.

Andrew Fergus · Jan 12, 2009

Hi Pedro

Nice solution. It appears our recursive process is doing a very similar thing in that it passes through the total so far and the minimum value to use. However, I am also passing an array back and forth to output the results (which you didn't actually ask for in your original post), and also your code starts from the bottom up, whereas mine starts from the top down. Nice solution though!

How about another challenge?

Andrew

Tough Problem 2 (vba)

pgc01

MrExcel MVP

Excel Facts

schielrn

Well-known Member

Greg Truby

MrExcel MVP

pgc01

MrExcel MVP

Andrew Fergus

MrExcel MVP

Oorang

Well-known Member

pgc01

MrExcel MVP

pgc01

MrExcel MVP

schielrn

Well-known Member

Andrew Fergus

MrExcel MVP

Forum statistics

Share this page

Tough Problem 2 (vba)

MrExcel MVP

Excel Facts

Well-known Member

MrExcel MVP

MrExcel MVP

MrExcel MVP

Well-known Member

MrExcel MVP

MrExcel MVP

Well-known Member

MrExcel MVP

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock