August Challenge of the Month Discussion

[bigbob]

Hi,Don't know if this is useful but if you just look at the rightmost digit of each invoice then can only be 0 to 9 .The sum of a valid combination of these must add to rightmost digit of wanted total
3 end in 0
3 end in 1
9 end in 2
6 end in 3
5 end in 4
5 end in 5
2 end in 6
8 end in 7
8 end in 8
5 end in 9
Taking invoices that end in 2 as example this will generate 0,2,4,6 or 8 as last digit dependant upon how many are in total .Doing same for other final digits gives different patterns and combining all possibilities gives final number of combinations of just over 1 x 10^6
This could be done by brute force
Hope this is understandable and hope it helps
Big bob

 

[bigbob]

Hi,Don't know if this is useful but if you just look at the rightmost digit of each invoice then can only be 0 to 9 .The sum of a valid combination of these must add to rightmost digit of wanted total
3 end in 0
3 end in 1
9 end in 2
6 end in 3
5 end in 4
5 end in 5
2 end in 6
8 end in 7
8 end in 8
5 end in 9
Taking invoices that end in 2 as example this will generate 0,2,4,6 or 8 as last digit dependant upon how many are in total .Doing same for other final digits gives different patterns and combining all possibilities gives final number of combinations of just over 1 x 10^6
This could be done by brute force
Hope this is understandable and hope it helps
Big bob

 

[mdfh]

bigbob

But won't doing that prove that it is possible that each invoice could form part of the total?
So on that basis that would mean that no invoice could be eliminated.

 

[MK]

Here are some of the solutions...I have limited the number of invoices to six. And there are quite a few that add up to the required amount.

2487.85 911.45 796.76 144.77 126.69 89.4
2487.85 691.83 630.92 440.93 160.62 144.77
1842.59 895.39 796.76 691.83 185.58 144.77
2487.85 722.73 698.27 346.35 185.58 116.14
1587.52 978.53 925.39 789.77 192.65 83.06
2487.85 680.23 673.47 444.98 192.65 77.74
2487.85 789.77 538.64 456.68 194.58 89.4
2487.85 796.76 722.73 228.31 194.58 126.69
2487.85 764.18 538.64 444.98 194.58 126.69
1587.52 983.98 895.39 789.77 222.52 77.74
1842.59 983.98 718.32 628.89 222.52 160.62
2487.85 925.39 441.43 329.17 228.31 144.77
2487.85 796.76 680.23 280.71 228.31 83.06
1842.59 925.39 858.97 507.08 228.31 194.58
2487.85 691.83 680.23 280.71 230.72 185.58
1842.59 925.39 895.39 456.68 244.22 192.65
2487.85 862.12 538.64 346.35 244.22 77.74
1587.52 983.98 978.53 507.08 280.71 219.1
1587.52 925.39 911.45 718.32 324.84 89.4
1842.59 789.77 764.18 673.47 409.17 77.74
1842.59 862.12 691.83 673.47 409.17 77.74
1842.59 983.98 628.89 441.43 440.93 219.1
1842.59 895.39 722.73 538.64 441.43 116.14
1842.59 722.73 698.27 673.47 542.12 77.74
1587.52 983.98 698.27 628.89 542.12 116.14
1842.59 718.32 680.23 628.89 542.12 144.77
1021.7 983.98 911.45 789.77 630.92 219.1
1587.52 911.45 789.77 680.23 365.43 222.52
1842.59 978.53 630.92 441.43 440.93 222.52
1842.59 1021.7 630.92 589.18 244.22 228.31
983.98 978.53 862.12 796.76 589.18 346.35
1842.59 858.97 542.12 538.64 409.17 365.43
1587.52 925.39 680.23 589.18 409.17 365.43
1842.59 698.27 673.47 456.68 444.98 440.93
1021.7 911.45 895.39 698.27 589.18 440.93
1021.7 911.45 862.12 691.83 628.89 440.93
1021.7 911.45 789.77 764.18 628.89 440.93
983.98 789.77 764.18 698.27 691.83 628.89

p.s. I haven't tried solving this problem using Excel yet, this is using SQL. If anybody is interested in knowing the solution, let me know.
This message was edited by MK on 2002-08-22 14:59

 

[Jay Petrulis]

On 2002-08-22 14:57, MK wrote:
Here are some of the solutions...I have limited the number of invoices to six. And there are quite a few that add up to the required amount.

---snip solutions---

p.s. I haven't tried solving this problem using Excel yet, this is using SQL. If anybody is interested in knowing the solution, let me know.
This message was edited by MK on 2002-08-22 14:59

Hi,

Go ahead and post your solution/routine. Who cares if it is in SQL? You may have ideas that others can take and transform into Excel. If it works, it is valuable on its own, too.

 

[IOANNIS]

Hi Jay Petrulis

Finally my macro had an error in how a variable pass its value (by value or by reference) which rejects solutions not combinations.The test with 16 numbers was ok but the numbers are integers ...

...i corrected it and i made some other changes too.I have no idea how to reject much more unusefull combinations, every attempt i made had as result of lost combinations or solutions, but the speed now is 20.000 to 38.500 solutions per hour !!!

I Replace the set of numbers with the first one and i recalc the solutions ..

The macro finish after 32 hours !!!

The total solutions of the first set is 747.003 (747.003/32=23344/hour)

I stoped trying to improve the macro but i will continue to check it for errors and until the month ends i will post it ...

Perhaps i recalc again with the second set of numbers to find the solutions that rejects before the correction.
...What is 32 hours of my computer's life...

 

[IOANNIS]

...My computer is PIII 800Mhz, 512Mb ram ...

 

[Sharad Kothari]

I have updated the code to add additional filter to speed the things and incorporated other cosmetic changes.

To explain the logic of the flow, the invoices are first sorted in ascending order and all the combinations are logically arranged is such a way that the highest values appear first and before other values. For e.g.

[ ]
.
.
53
53 52
53 52 51
.
53 52 51 50 ….. 3 2 1
53 52 50
.
53 13
53 13 12
.
53 1
52

[/ ]

The first filter, which was available in the code which I earlier posted, is that if the sum of any combinations is greater than the "Target Sum" then rest of the combination starting with that combination is skipped. For e.g. the sum of invoice number (sorted in ascending order) 53, 52, 51 (2487.85,1842.59,1587.52) is 5917.96 which is greater than target sum 4556.92 therefore rest of the combinations starting with 53, 52, 51 would be skipped and logic flows to next combination which is 53 52 50.

The second filter is that if the sum of balance invoices is less than (“Target Sum” – sum of current combination) than such invoices are skipped. For e.g. the sum of invoices 53 and 1 to 13 is 4529.01 which is less than the “Target Sum” therefore all combinations starting with 53 and with next invoice of 13 or less are skipped. In the above example the code will be skipped to combination starting with 52.

The next problem is how to store the successful combinations as the size of significantly high. I first thought of storing the sequence number of the successful combination. I also developed two functions in this regard for returning combination from a sequence number and for returning sequence number from a combination. However, since precision number limit for Excel is 15 digit, I could not figure out how to store the exact sequence number. Therefore, I combined the invoice number of successful invoices and stored into a single cell. For e.g. the first successful combination generated by the code is stored as:

_53_50_30_13_4_2_1

I have used he function “Combinations” to return the array of invoices from the above.

The code is given below. To use the code, simply paste in a module. And run the procedure “Main”.

The speed of the code is significantly better than the code I last posted. It throws more than 1200 successful results within the first minute. The speed than settles around 45k/50k per hour.

if the code is stopped, than subsequently it can be resumed from that point only - from the last successful combination.

Option Base 1
Option Explicit

Const cRangeSuccess = "B3"
Const cRangeTime = "B4"
Const cRangeLastComb = "B2"
Const cStartColumn = 4
Const cRefreshDelay = 10 'in seconds
Dim dSuccessCount As Double
Dim sLastComb As String
Dim lCurTime As Long

Dim aStack() As Integer
Dim lCurRow As Long, nCurCol As Integer
Dim aInvoice() As Currency
Dim curTarget As Currency

Sub Main()

Dim sLastCombNo As String
Dim nP1 As Integer, nP2 As Integer
Dim nCurStackElement As Integer
Dim n As Integer, m As Integer
Dim nCurInvoice As Integer, curBalanceSum As Currency
Dim rngTmp As Range

Application.ScreenUpdating = False

lCurTime = Timer()

Sheets("Sheet1").Activate

SetValues 'store all invoices to array aInvoice and sort in ascending order

ReDim aStack(UBound(aInvoice)) 'Stack contains the pointer to array of invoices

sLastCombNo = Range(cRangeLastComb)

If sLastCombNo = "" Then 'Start fresh
    
    SetupWS

    Range(cRangeTime) = 0

    lCurRow = 1
    nCurCol = cStartColumn

    For n = 1 To UBound(aInvoice)
        curBalanceSum = curBalanceSum + aInvoice(n)
    Next

    SearchTarget curTarget, curBalanceSum, UBound(aInvoice), 0

Else 'Continue

    nCurCol = cStartColumn + Cells(1, cStartColumn).CurrentRegion.Columns.Count - 1
    Set rngTmp = Cells(1, nCurCol).EntireColumn.Find("")
    If Not rngTmp Is Nothing Then
        lCurRow = rngTmp.Row
    Else
        lCurRow = 1
        nCurCol = nCurCol + 1
    End If

    dSuccessCount = Range(cRangeSuccess)

    'Update stack from the Last Combination No.
    Do
        nP1 = IIf(nP2 = 0, 1, nP2)
        nP2 = InStr(nP1 + 1, sLastCombNo, "_")
        nCurStackElement = nCurStackElement + 1
        If nP2 > 0 Then
            aStack(nCurStackElement) = Val(Mid(sLastCombNo, nP1 + 1, nP2 - nP1 - 1))
        Else
            aStack(nCurStackElement) = Val(Mid(sLastCombNo, nP1 + 1))
        End If
        curTarget = curTarget - aInvoice(aStack(nCurStackElement))
    Loop While nP2 > 0

    For n = nCurStackElement To 1 Step -1
        'till the last value of stack i.e [aStack(nCurStackElement] the combinations
        'has already been tested. Next in order would be invoice number of last value of stack minus 1
        nCurInvoice = aStack(n) - 1
        curTarget = curTarget + aInvoice(aStack(n))
        aStack(n) = 0
        For m = nCurInvoice To 1 Step -1
            curBalanceSum = curBalanceSum + aInvoice(m)
        Next
        SearchTarget curTarget, curBalanceSum, nCurInvoice, n - 1
    Next
End If

Application.ScreenUpdating = True

End Sub

' Main Recursive Routine
Sub SearchTarget(curTarget As Currency, curBalanceSum As Currency, nCurInvoice As Integer, nCurStackElement As Integer)
Dim curRevisedTarget As Currency, curRevisedBalanceSum As Currency
Dim n As Integer, m As Integer
Dim lDelay As Long 'Edit 26 Aug


If curBalanceSum >= curTarget Then
    curRevisedBalanceSum = curBalanceSum
    
    For n = nCurInvoice To 1 Step -1
        
        curRevisedBalanceSum = curRevisedBalanceSum - aInvoice(n)

        If aInvoice(n) = curTarget Or Timer() - lCurTime > cRefreshDelay Then
            
            m = 1
            sLastComb = ""
            Do While m<= UBound(aStack) And aStack(m) > 0
                sLastComb = sLastComb & "_" & Trim(Str(aStack(m)))
                m = m + 1
            Loop
            sLastComb = sLastComb & "_" & n
                     
            If aInvoice(n) = curTarget Then
                dSuccessCount = dSuccessCount + 1
                Range(cRangeLastComb) = sLastComb
                Cells(lCurRow, nCurCol) = sLastComb
                Range(cRangeSuccess) = dSuccessCount
                lCurRow = lCurRow + 1
                If lCurRow > ActiveSheet.Rows.Count Then
                     lCurRow = 1
                     nCurCol = nCurCol + 1
                End If
            End If

            lDelay = Timer() - lCurTime '-> Edit 26-Aug
            
            If lDelay > cRefreshDelay Or lDelay< 0 Then ' Edit 26-Aug
                Range(cRangeTime) = Range(cRangeTime) + IIf(lDelay< 0, cRefreshDelay, lDelay) 'Edit 26-Aug
                Application.ScreenUpdating = True
                Application.ScreenUpdating = False
                lCurTime = Timer()
            End If
        
        End If
    
          
        If aInvoice(n)< curTarget And n > 1 Then
            curRevisedTarget = curTarget - aInvoice(n)
            nCurStackElement = nCurStackElement + 1
            aStack(nCurStackElement) = n
            SearchTarget curRevisedTarget, curRevisedBalanceSum, n - 1, nCurStackElement
            aStack(nCurStackElement) = 0
            nCurStackElement = nCurStackElement - 1
        End If

    Next

End If

End Sub

Sub SetValues()

ReDim aInvoice(54)
aInvoice(1) = 895.39
aInvoice(2) = 83.06
aInvoice(3) = 280.71
aInvoice(4) = 1021.7
aInvoice(5) = 219.1
aInvoice(6) = 1587.52
aInvoice(7) = 507.08
aInvoice(8) = 628.89
aInvoice(9) = 222.52
aInvoice(10) = 192.65
aInvoice(11) = 194.58
aInvoice(12) = 764.18
aInvoice(13) = 680.23
aInvoice(14) = 244.22
aInvoice(15) = 89.4
aInvoice(16) = 862.12
aInvoice(17) = 1842.59
aInvoice(18) = 329.97
aInvoice(19) = 444.98
aInvoice(20) = 630.92
aInvoice(21) = 440.93
aInvoice(22) = 324.84
aInvoice(23) = 978.53
aInvoice(24) = 144.77
aInvoice(25) = 230.72
aInvoice(26) = 456.68
aInvoice(27) = 126.69
aInvoice(28) = 2487.85
aInvoice(29) = 515.11
aInvoice(30) = 911.45
aInvoice(31) = 983.98
aInvoice(32) = 329.17
aInvoice(33) = 673.47
aInvoice(34) = 409.17
aInvoice(35) = 228.31
aInvoice(36) = 796.76
aInvoice(37) = 116.14
aInvoice(38) = 858.97
aInvoice(39) = 718.32
aInvoice(40) = 346.35
aInvoice(41) = 542.12
aInvoice(42) = 589.18
aInvoice(43) = 789.77
aInvoice(44) = 185.58
aInvoice(45) = 538.64
aInvoice(46) = 441.43
aInvoice(47) = 925.39
aInvoice(48) = 698.27
aInvoice(49) = 5465.45
aInvoice(50) = 160.62
aInvoice(51) = 722.73
aInvoice(52) = 691.83
aInvoice(53) = 77.74
aInvoice(54) = 365.43

ASort aInvoice

curTarget = 4556.92

End Sub




Sub ASort(ByRef aArray, Optional nOrder As Integer)

' Sort Single Dimenstion Array

Dim nLength As Integer, nJump As Integer, nUpper As Integer
Dim nLower As Integer
Dim bFinished As Boolean
Dim vntTmp As Variant

nLength = UBound(aArray)
nJump = 1

Do While nJump<= nLength
    nJump = nJump * 2
Loop

Do While nJump > 1
    nJump = (nJump - 1)
    Do
        bFinished = True
        For nUpper = 1 To nLength - nJump
            nLower = nUpper + nJump
            If (nOrder >= 0 And aArray(nUpper) > aArray(nLower)) _
             Or nOrder< 0 And aArray(nUpper)< aArray(nLower) Then
                vntTmp = aArray(nUpper)
                aArray(nUpper) = aArray(nLower)
                aArray(nLower) = vntTmp
                bFinished = False
            End If
        Next nUpper
    Loop Until bFinished
Loop

End Sub

Sub SetupWS()

    With Range("A1")
        .Value = "Summary"
        .Font.Bold = True
        .Font.Underline = True
    End With
    
    With Range(cRangeLastComb)
        .Offset(0, -1) = "Last_Comb"
        .Offset(0, -1).EntireColumn.ColumnWidth = 14
        .ShrinkToFit = True
        .EntireColumn.ColumnWidth = 35
    End With
    
    With Range(cRangeSuccess)
        .Offset(0, -1) = "Success"
        .HorizontalAlignment = xlCenter
    End With
    
    With Range(cRangeTime)
        .Offset(0, -1) = "Seconds"
        .HorizontalAlignment = xlCenter
        .NumberFormat = "0"
        .Offset(1, -1) = "Success/Hour"
        .Offset(1, 0).Formula = "=ROUND(" & cRangeSuccess & "/" & cRangeTime & "*3600/1000,0)*1000"
        .Offset(1, 0).HorizontalAlignment = xlCenter
    End With
    
End Sub

Function Combinations(sCurComb As String)

Dim nP1 As Integer, nP2 As Integer
Dim nCurStackElement As Integer

SetValues
Dim aStackValues() As Currency
ReDim aStackValues(UBound(aInvoice))

Do
    nP1 = IIf(nP2 = 0, 1, nP2)
    nP2 = InStr(nP1 + 1, sCurComb, "_")
    nCurStackElement = nCurStackElement + 1
    If nP2 > 0 Then
        aStackValues(nCurStackElement) = aInvoice(Val(Mid(sCurComb, nP1 + 1, nP2 - nP1 - 1)))
    Else
        aStackValues(nCurStackElement) = aInvoice(Val(Mid(sCurComb, nP1 + 1)))
    End If
Loop While nP2 > 0

Combinations = aStackValues
End Function

EDIT - Edited to correct seconds counter which stooped at midnight as Timer function is reset. - Sharad Kothari, 26August
This message was edited by Sharad Kothari on 2002-08-25 22:41

 

[Sharad Kothari]

I have finished running my code which I recently posted; stoping and restarting sevaral times.

The total solutions are 747004 which is one more than mentioned by IOANNIS, although there is all probability of counting error on my part as I interrupted the execution of program sevaral times. The estimated time is about 24 hours at a speed of about 30K. This was on my laptop - PIII and 128MB Ram.

I tried the same code on my desktop - P4 and 256MB Ram - for about 15 minutes and the average speed was 85K per hour. Therefore, I expect to process all the combinations on my desktop in less than 10 hours, which I will try tonight.

Some additional Oservations:
=> After storing all the 747K results, the file size goes up to 40MB.
=> The speed can be increased furhter, if only summary of result is maintained instead of storing all the result.
=> Even while storing all the results, the speed can be increased slightly by increasing the RefreshDealy.
=> In my first code, I was using Double Data type, to store the Invoices, which was skipping a lot of successful combination due to insignificant decimal digit. After converting the data type to Currency, the code is working properly.
=> Just by applying one additional filter, the speed of the code has increased significantly. I do not have any clue of any further filter, but if such further filter could be applied, it should further improve the speed.

 

[Sharad Kothari]

I have finished processing the code on my P4-256MHz. The possible combinations are 747003 and it took 9Hours and 24 Minutes at an average speed of 79K per hour to process all the invoices.