One for the mathematicians - finding combinations?

[Binraider]

Hi all,

Let's say we have 5 numbers: 1, -2, -3, -4 & 3. Let's also have a target figure of 1.

If we limit ourselves to summing only two of the first 5 numbers, there are only two combinations that can give 1.

There are probably more solutions if you allow the use of more than 2 of the selection.

What I'd like to do is automatically hunt for such solutions, in a large block of data. To fully implement what I have in mind, I'm looking at finding all possible combinations in approx 200 columns of data, across a long series of days.

The idea is that if certain columns appear repeatedly as possible results over a long series of days, then the subject of those columns could be regarded as suspect and worthy of further investigation.

Where this becomes mind boggling is the number of potential combinations for such numbers of columns - I believe I'm hunting for values out of 200 factorial possibles.

The other thing is the real data set I'm working with includes decimal figures, so I'd probably have to have some sort of rule to allow for this. Perhaps allowing the target figure to be +- 0.05 and look for combinations in the data that match the range, rather than the exact figure.

This sounds like something a clever mathematician might be able to cobble up. Any suggestions?

In terms of tools I have a couple of options on what I can run this in - my office machines have 32-bit Excel & Access 2003, although I could run this in 64-bit Excel/Access 2010 at home. Possibly a good idea given I have 12GB of RAM installed on my home machine, as opposed to 2GB on the work one.

Dave

 

[robertgama]

If you take away the math problem, what are you in fact trying to do? Just find suspected duplicate rows?

Also, you should post a screen shot example of some of the data.

 

[Binraider]

I am hunting for all possible combinations of inputs (columns) that could total up to a particular target figure (stored in the final column), for each day (row).

If, in a long series of days, the same columns appear repeatedly as being likely contributors to the target figure, then the suspicion is that there is something wrong with the system feeding information into that column. (Which would be verified by other investigation).

The full dataset is itself confidential hence why I included a simplified example. Obvious solutions could be 3+(-2), or 1+(-3)+3. I could maybe make up some larger examples if it will help.

The trick is for a large data set I need some sort of automation to try and come up with these solutions.

 

[shg]

Suppose you have 200 numbers that range from $0.00 to $1,000,000.00 (having negative numbers doesn't change the analysis), and the total of all those values happens to be a nice round $100,000,000.00. That means that all combinations must total between those limits, so there are, at most, 10,000,000,000 (10 billion, 1E10) different totals.

There are 2^200 combinations of those numbers, varying between choosing none of them to choosing all of them. That's 1.6E60 combinations.

So there are 1E10 possible totals, and 1.6E60 combinations; then, on average, you can arrive at any GIVEN total in 1.6E60/1E10 = 1.6E50 ways, a mind-bogglingly large number. Of course, there will be fewer ways to arrive at some totals, and more ways to arrive at others.

The bottom line is, you will never be able to draw any conclusions from a dataset this size.

 

[TheVillageIdiot]

This is similar to the August 2002 Challenge of the month.

Link

 

[chirp]

i agree with shg about this...to even make something like this at all viable would be if the total you were looking for was on the order of the average element in your search list. then you could break out of combination "trees" early, and not loop through all combinations.

conditions for making this somewhat feasible would be:

-all positive
-all within the order of the target..ie if the target is 10 then your range could be from 1 to 10 (ish, this range would shrink with higher n values such as 200).

even with these conditions satisfied it is likely you will not be able to derive valid data, as the number of matches in such a set is likely to be much higher than you anticipate

 

[mortgageman]

i agree with shg about this...to even make something like this at all viable would be if the total you were looking for was on the order of the average element in your search list. then you could break out of combination "trees" early, and not loop through all combinations.

conditions for making this somewhat feasible would be:

-all positive
-all within the order of the target..ie if the target is 10 then your range could be from 1 to 10 (ish, this range would shrink with higher n values such as 200).

even with these conditions satisfied it is likely you will not be able to derive valid data, as the number of matches in such a set is likely to be much higher than you anticipate

Why do you say that making the numbers all positive would make it more feasible?

Gene Klein

 

[chirp]

i wrote a function for this purpose recently based off of this idea:

http://www.tushar-mehta.com/excel/templates/match_values/index.html#VBA_multiple_combinations

the degree of optimization largely depends on the target and its relation to the data set

you can either sort your data ascending or descending. with ascending negatives dont change anything, but with descending its a little trickier.

the key advantage to descending sort is that it naturally cuts down the number of iterations (in (almost?) all situations).

because we are dealing with recursive (n-1).. behaviour, the majority of the loops are at the "start" of the search.

ie for {1,2,3,4} you have:

1
1,2
1,2,3
1,2,3,4
1,2,4
1,3
1,3,4
1,4
2
2,3
2,3,4
2,4
3
3,4
4

so this simple visual representation clearly shows there is a large portion of the combinations that will have the value at index "1" as the start value.

intuitively it makes sense that if we are trying to maximize each combination as soon as possible (exit with a minimum loop) it makes more sense to go about it like this: (for a target of 5)
4,2 -exit
than like
1,1,2,4-exit

this general result can have a large or small impact depending on the data and the target.

with ascending you can use a couple of tricks to bring its result comparable to the descending, but not below (in most cases...please let me know if you find a case where this is not true...they are equal for constant values)

there are a couple cases to consider.

the second condition is also intuitive as the target approaches the sum of the data set, the number of iterations approaches: sum n=1 to k(k choose n)
which is an extremely large number even for small data sets

so i found that in all data types (and by "all" i do not mean a rigorous "all") the descending order sort used significantly fewer loops (for the above reasons).

now using the test where some tempVal>Target when there are negatives "coming up" will not work, so essentially you would have to use either a more involved check that still would not cut down the loops that much (using the total of all negatives after current loop for example..could prepopulate a running sum array) or use the ascending sort...

so in conclusion, from my rather limited experience (and i would love to be shown how to do this better), having negatives forces you to change some things that will slow things down quite a bit...

note that the tempVal>Target is run EVERY LOOP which is a huge number of times, easily in the 10 to 100's of millions for small data sets, so any additional check has a large impact.

that is how i think about it, again i would love to see a more rigorous mathematical proof of this, but it largely depends on the data and the target so im not sure if a simple solution modeling ascending/descending sort would exist.

 

[chirp]

Just because i would like to know how to improve this function ill post my solution to this problem. i find that it is faster and simpler than the solutions from the challenge of the month previously referenced.

the fastest and simplest way to run this is to copy and paste each following code segment into a separate module (6 in total)

this does not have a very relevant output, it returns solutions as a string of indexes, with each index representing the index of an element in a sorted, reversed, array with any values greater then the goal total, as well as blanks, removed.

i worked on it for some time, and would really appreciate it if someone pointed out some areas to improve

Main

Option Explicit
Option Base 0

'arrays
Private solutionArray() As String, rowArr() As Long, finalDataArray() As Double
Private doAdd() As Boolean

'longs, counters and index
Private numSolutions As Long, solutionCount As Long, uBoundSolution As Long, recNum As Long
Private maxRec As Long, arraySizeJump As Long, lBnd As Long, uBnd As Long, savedUbound As Long

'doubles used for holding running total
Private GoalTotal As Double, allowableDiff As Double

'some booleans used to set/test for constant parameters
Private exitRecursion As Boolean

'returns combinations that match the goalTot of an all positive data set
'the default allowable difference should remain set at some non-zero small number (not beyond double accuracy)
Public Function getAllMatchComb(goalTot As Double, _
                                dataArray As Variant, _
                                Optional numSolution As Long = 0, _
                                Optional maxRecursion As Long = -1, _
                                Optional allowableDifference As Double = 0.000000001, _
                                Optional resizeSolutionJump As Long = 5000, _
                                Optional includeAll As Boolean = True) _
                                As Variant
                                
Dim arraySize As Long, i As Long, maxFirst As Long
Dim funcTst As Boolean
Dim tstMatch As Variant, tArr As Variant
Dim tmpSUM As Double

On Error GoTo exitFunc

'checks if dataarray is array just for fun (time spent here is not going to be significant)
If Not IsArray(dataArray) Then Exit Function
'checks that redimension is >0
If resizeSolutionJump < 1 Then Exit Function

'sets inputs to module level variables
numSolutions = numSolution
GoalTotal = goalTot
arraySizeJump = resizeSolutionJump
allowableDiff = allowableDifference

'//Return a one dimensioned Array
'ensure input is one dimension (not just one dim, but also any entries that are
'arrays are "straightened out", this is an easy (probably not fastest) way of converting
'variant arrays from ranges to simple one dim arrays, order here does not matter

'****always returns a 0 based array*****
tArr = getOneDimArray(dataArray)
'****here after assume array is 0 based****

'get bounds of input
lBnd = LBound(tArr) '0
uBnd = UBound(tArr)

'//Sort Array
'sorts the input array
Call QSortE(tArr, , funcTst)
If Not funcTst Then Exit Function

'//Checks a few parameters to see if valid input
'if the data has negatives than overages can not be skipped
If hasNegatives(tArr) Then
    Exit Function
Else
    With WorksheetFunction
        'gets the index of the last entry less then or equal to the search total
        'tarr is sorted ascending at this point
        On Error Resume Next
        tstMatch = .Match(goalTot, tArr, 1)
        On Error GoTo exitFunc
        
        'if no error then resize array to exclude values larger than the target
        If Err.Number = 0 Then
            uBnd = tstMatch - 1
            ReDim Preserve tArr(lBnd To uBnd)
        End If
        
        'if total sum of entries is less then total exit
        If .Sum(tArr) < goalTot Then Exit Function
        'exits if goal total is less then smallest entry in list
        If goalTot < .Min(tArr) Then Exit Function
    End With
End If

'//ReFormat array
'reverses array and removes blanks and 0's
tArr = revArrayN(delFromArraySmall(tArr, 0), True)

'gets final array size
uBnd = UBound(tArr)
lBnd = LBound(tArr) 'shouldnt have changed but just in case
arraySize = getArraySize(tArr)

'exits if not enough elements
If arraySize < 3 Then Exit Function

'//Gets max elements per solution, as well as the Max index of the first recursion level
'This iterates from the smallest to largest in the array, finding the maximum
'number of elements that could possibly make up a solution
Do While tmpSUM <= goalTot And i <= uBnd
    tmpSUM = tmpSUM + tArr(uBnd - i)
    i = i + 1
Loop

'scale i back to reflect true max valid recursion level
i = i - 1

If maxRecursion < 1 Then
    maxRec = i                      'relative to 1 base
    maxFirst = arraySize - i - 1    'relative to 0 base
ElseIf maxRecursion < i Then
    i = 0
    'this gets the maximum point at which the n element set of contigious values falls
    'below the goal total
    Do While sumPart(tArr, lBnd + i, i + lBnd + maxRecursion - 1) >= goalTot
        If i + lBnd + maxRecursion - 1 > uBnd Then Exit Do
        i = i + 1
    Loop
    
    maxRec = maxRecursion           'relative to 1 base
    maxFirst = i - 1                'relative to 0 base
Else: Exit Function    'this means no matches
End If

'sets the bounds of the final solution array
If numSolutions > 0 Then
    uBoundSolution = numSolutions
Else: uBoundSolution = uBnd * uBnd * uBnd 'this term is arbitrary, ubnd^3 just so it scales a bit with size of search
End If

'//sets the dimensions of a few arrays used for results
'sets the bounds for the array to hold solutions 1 at a time
ReDim rowArr(1 To maxRec)
ReDim solutionArray(1 To uBoundSolution)
ReDim finalDataArray(lBnd To uBnd)
ReDim doAdd(1 To maxRec)
ReDim uBndArr(1 To maxRec)

'populates doAdd array (boolean)
For i = 1 To maxRec
    If includeAll Then
        doAdd(i) = True
    ElseIf i <> maxRec Then
        doAdd(i) = False
    Else: doAdd(i) = True
    End If
Next

'populates final array (double)
For i = lBnd To uBnd
    finalDataArray(i) = CDbl(tArr(i))
Next

'sets ubound to the initial value of maxFirst
savedUbound = uBnd
uBnd = maxFirst

'**************************************************
'**************************************************
Call matchRecurse(lBnd, 0) 'call actual function
'**************************************************
'**************************************************

'redim or erase array
If solutionCount > 0 Then
    ReDim Preserve solutionArray(1 To solutionCount)
Else: Erase solutionArray
End If

'return solutions
getAllMatchComb = solutionArray

exitFunc:
'reset some global variables
allowableDiff = 0: uBoundSolution = 0
solutionCount = 0: maxRec = 0
exitRecursion = False
recNum = 0: Erase doAdd
Erase rowArr: uBnd = 0
Erase solutionArray: lBnd = 0

End Function


Private Function matchRecurse(curInd As Long, _
                            curTotal As Double)

Dim tempTotal As Double
Dim i As Long

'increment the recursion number each call
recNum = recNum + 1

'not sure how to do this faster
If recNum <> 1 Then uBnd = savedUbound

'loop through from input to upperbound
For i = curInd To uBnd
    'set a variable to the current running total
    tempTotal = curTotal + finalDataArray(i)
    
    Select Case tempTotal - GoalTotal
        Case Is < -allowableDiff
            If recNum < maxRec Then
                If i < uBnd Then
                    'adds to row array
                    rowArr(recNum) = i - lBnd + 1 'row arr keeps track from 1..up, whereas all else is 0 based
                    'calls itself
                    Call matchRecurse(i + 1, tempTotal)
                    If exitRecursion Then Exit Function
                Else: GoTo skipChecks
                End If
            Else: GoTo skipChecks
            End If
        Case Is > allowableDiff
            GoTo skipChecks
        Case Else
            If doAdd(recNum) Then
                'sets the row array to the current row
                rowArr(recNum) = i - lBnd + 1 'this is assuming that lbnd is 0..returns WRONG results in some other cases
                
                'increments the solution count then adds to the solutionarray
                'if the solution count exceeds the array size than the array is redimensioned
                'this is expensive so arraySizeJump is good to be large
                solutionCount = solutionCount + 1
                
                'checks to redim
                If solutionCount > uBoundSolution Then
                    ReDim Preserve solutionArray(1 To uBoundSolution + arraySizeJump)
                    uBoundSolution = uBoundSolution + arraySizeJump
                End If
                
                'actually sets
                solutionArray(solutionCount) = getArrayStr(rowArr)
                
                'decides if exit
                If numSolutions = solutionCount Then
                    exitRecursion = True
                    Exit Function
                End If
            End If
    End Select
skipChecks:
Next

'delete entry in rowarr
rowArr(recNum) = 0

'decrement recursion number
recNum = recNum - 1

End Function

Test

Option Explicit
Option Base 0

Sub testFunctions()
Dim dic As Object
Dim dt As Date

Dim v, v1, V2
Dim L As Long, L1 As Long, L2 As Long
Dim s As String, S1 As String, S2 As String
Dim R As Range, R1 As Range, R2 As Range
Dim D As Double, D1 As Double, D2 As Double
Dim ws As Worksheet, WS1 As Worksheet, WS2 As Worksheet
Dim WB As Workbook, WB1 As Workbook, WB2 As Workbook
Dim ob As Object, ob1 As Object, ob2 As Object
Dim i As Long, i1 As Integer, i2 As Integer

'for test funtion operation
Dim timSum() As Double
Dim tim As Double
Dim j As Long, trialName As String

Const numTrials As Long = 1
Const printResult As Boolean = True
trialName = "Test combo finder:"
ReDim timSum(1 To numTrials)

'moves a range to a variant array
v = Selection.Value2

For j = 1 To numTrials
    tim = microTimer
    For i = 1 To 1
        v1 = getAllMatchComb(4557.92, v, 1000)
    Next
    timSum(j) = microTimer - tim
Next

If printResult Then
    With WorksheetFunction
        Debug.Print Chr(13) & trialName & Chr(13) & "Total time: " & .Sum(timSum) & Chr(13) & "Average: " & .Average(timSum) & Chr(13) & "Max: " & .Max(timSum) _
                        & Chr(13) & "Min :" & .Min(timSum)
        On Error Resume Next
        Debug.Print "Standard Deviation: " & .StDev(timSum) & Chr(13)
    End With
End If
Set dic = Nothing
End Sub

Declarations

Option Explicit
Option Base 0

'windows api call
                
Public Declare Function getFrequency Lib "kernel32" _
                    Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long

Public Declare Function getTickCount Lib "kernel32" _
                    Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Functions

Option Explicit
Option Base 0

'from msdn
Function microTimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency

microTimer = 0
' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
    getTickCount cyTicks1
' Seconds
    If cyFrequency Then microTimer = cyTicks1 / cyFrequency
End Function

'checks if an array has any negative values

Public Function hasNegatives(arr) As Boolean
Dim tVar As Variant

On Error GoTo exitFunc
If Not IsArray(arr) Then Exit Function

For Each tVar In arr
    If tVar < 0 Then
        hasNegatives = True
        Exit Function
    End If
Next

exitFunc:
End Function

'simple takes an array and reverses it, copys, requires array mem*2
Public Function revArrayN(arr, _
                        Optional skipBlanks As Boolean = False, _
                        Optional tst As Boolean) As Variant()
Dim tVar, tArr
Dim i As Long

tst = False
On Error GoTo exitFunc

If Not IsArray(arr) Then Exit Function

i = UBound(arr)
ReDim tArr(LBound(arr) To i)

For Each tVar In arr
    If skipBlanks Then If tVar = vbNullString Then GoTo nxt
    tArr(i) = tVar
    i = i - 1
nxt:
Next

revArrayN = tArr
tst = True
exitFunc:
End Function

Public Function getArraySize(testArray, _
                            Optional testDim As Long = 1, _
                            Optional tst As Boolean) As Long
tst = False
On Error GoTo exitFunc
    getArraySize = UBound(testArray, testDim) - LBound(testArray, testDim) + 1
    tst = True
exitFunc:
End Function

'sums part of an array
Public Function sumPart(arr, ind1 As Long, ind2 As Long, _
                        Optional tst As Boolean) As Double
                        
Dim i As Long
Dim mn As Double, mx As Double

mn = rMin(ind1, ind2)
mx = rMax(ind1, ind2)

On Error Resume Next
For i = mn To mx
    If isNumber(arr(i)) Then sumPart = sumPart + arr(i)
Next

tst = Err.Number = 0

End Function

'faster than worksheet function for individually entered numbers ie paramarray=1,3,5,,6,4,2
Public Function rMax(ParamArray testNums() As Variant) As Double
Dim tVar, notFirst As Boolean

On Error Resume Next
For Each tVar In testNums
    If Not isNumber(tVar) Then GoTo nxt
    If notFirst Then
        If tVar > rMax Then rMax = tVar
    Else
        rMax = tVar
        notFirst = True
    End If
nxt:
Next

End Function

'faster than worksheet function for individually entered numbers ie paramarray=1,3,5,,6,4,2
Public Function rMin(ParamArray testNums() As Variant) As Double
Dim tVar, notFirst As Boolean

On Error Resume Next
For Each tVar In testNums
    If Not isNumber(tVar) Then GoTo nxt
    If notFirst Then
        If tVar < rMin Then rMin = tVar
    Else
        rMin = tVar
        notFirst = True
    End If
nxt:
Next

End Function

Public Function isNumber(testVar, _
                        Optional trueIfConvertable As Boolean = False) As Boolean

On Error GoTo exitFunc
Select Case VarType(testVar)
    Case 2 To 7, 14
        isNumber = True
    Case 8
        If trueIfConvertable Then
            If IsNumeric(testVar) Then isNumber = True
        End If
End Select

exitFunc:
End Function

'returns a string from an array
Public Function getArrayStr(arr, _
                        Optional Seperator As String = ",", _
                        Optional excludeVar = 0) As String
Dim tVar As Variant
Dim useSep As Boolean

On Error GoTo exitFunc

For Each tVar In arr
    If tVar <> excludeVar Then
        If useSep Then
            getArrayStr = getArrayStr & Seperator & tVar
        Else
            getArrayStr = tVar
            useSep = True
        End If
    End If
Next

exitFunc:
End Function

Public Function delFromArraySmall(arr, deleteThis, _
                            Optional matchCase As Boolean = True, _
                            Optional tst As Boolean) As Variant()
Dim tVar As Variant, tTst As Variant
Dim storeArr As Variant, cnt As Long
Dim isArr As Boolean


tst = False
On Error GoTo exitFunc

If IsArray(deleteThis) Then isArr = True
    
ReDim storeArr(0 To UBound(arr) - LBound(arr))

For Each tVar In arr
    If isArr Then
        For Each tTst In deleteThis
            If matchCase Then
                If tVar = tTst Then GoTo nxt
            ElseIf UCase(tVar) = UCase(tTst) Then GoTo nxt
            End If
        Next
    ElseIf tVar = deleteThis Then
        GoTo nxt
    End If
    
    'makes it here than not in array...should really clean this function up
    storeArr(cnt) = tVar
    cnt = cnt + 1
nxt:
Next

ReDim Preserve storeArr(0 To cnt - 1)
delFromArraySmall = storeArr

tst = True
exitFunc:
End Function

Recursive One Dim Function

Option Explicit
Option Base 0

Private tempArray As Variant
Private firstAdd As Long, incAdd As Long, uBnd As Long
Private cnt As Long



Public Function getOneDimArray(inputVar, _
                                Optional expectedSize As Long = 5000, _
                                Optional incrementalAdd As Long = 1000, _
                                Optional tst As Boolean _
                                ) As Variant()
Dim tmpArr As Variant

tst = False
On Error GoTo exitFunc
'set global variables to input
If expectedSize < 1 Then Exit Function
firstAdd = expectedSize
If incrementalAdd < 1 Then Exit Function
incAdd = incrementalAdd

'redim temparray to the expected size (input)
ReDim tempArray(0 To firstAdd)
uBnd = firstAdd
cnt = 0: uBnd = 0

'actually call function
Call recurseOneDim(inputVar, tst)

'if tst returns true then return the temparray
If tst Then
    tst = False 'just in case cnt is 0
    ReDim Preserve tempArray(0 To cnt - 1)
    getOneDimArray = tempArray
    tst = True
End If

exitFunc:
End Function


'simple recursive function to "straighten out" any variant array
'very slow should be used only in specific circumstances
'will not currently work with objects etc...easily adapted
Private Function recurseOneDim(testArray, Optional tst As Boolean)

Dim tVal As Variant

tst = False
On Error GoTo exitFunc

For Each tVal In testArray
    If Not IsArray(tVal) Then
        If cnt > uBnd Then
            uBnd = uBnd + incAdd
            ReDim Preserve tempArray(0 To uBnd)
        End If
        
        tempArray(cnt) = tVal
        cnt = cnt + 1
    Else
        Call recurseOneDim(tVal, tst)
        If tst = False Then Exit Function
    End If
Next

tst = True
exitFunc:
End Function

Recursive sort (qsort)

Option Explicit
Option Base 0

Private arrayType As Long
Private compareMeth As VbCompareMethod
Private pivot As Variant
Private tmpLow As Long, tmpHI As Long
Private tmpSwap As Variant

'simple qSort...picks the pivot at halfway point...
Private Function recurseSort(vArray As Variant, _
                            inLow As Long, _
                            inHi As Long)

On Error GoTo exitFunc
tmpLow = inLow
tmpHI = inHi

pivot = vArray((inLow + inHi) \ 2)

Do While (tmpLow <= tmpHI)
    Select Case arrayType
        Case 2 To 7, 12, 14, 17
            Do
                If vArray(tmpLow) >= pivot Then Exit Do
                If tmpLow >= inHi Then Exit Do
                tmpLow = tmpLow + 1
            Loop
            
            Do
                If pivot >= vArray(tmpHI) Then Exit Do
                If tmpHI <= inLow Then Exit Do
                tmpHI = tmpHI - 1
            Loop
        Case 8
            Do
                If StrComp(vArray(tmpLow), pivot, compareMeth) <> -1 Then Exit Do
                If tmpLow >= inHi Then Exit Do
                tmpLow = tmpLow + 1
            Loop
            
            Do
                If StrComp(vArray(tmpLow), pivot, compareMeth) = -1 Then Exit Do
                If tmpHI <= inLow Then Exit Do
                tmpHI = tmpHI - 1
            Loop
        Case Else
            'other data types not supported
            Exit Function
    End Select


    If (tmpLow <= tmpHI) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHI)
        vArray(tmpHI) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHI = tmpHI - 1
    End If
Loop

If (inLow < tmpHI) Then recurseSort vArray, inLow, tmpHI
If (tmpLow < inHi) Then recurseSort vArray, tmpLow, inHi

exitFunc:
End Function

Public Function QSortE(vArray As Variant, _
                        Optional strCompareMode As VbCompareMethod = vbBinaryCompare, _
                        Optional tst As Boolean)

tst = False
On Error GoTo exitFunc
If Not IsArray(vArray) Then Exit Function
arrayType = VarType(vArray) - 8192
compareMeth = strCompareMode
Call recurseSort(vArray, LBound(vArray), UBound(vArray))

tst = True

exitFunc:
arrayType = 0: pivot = Empty
tmpLow = 0: tmpHI = 0
tmpSwap = Empty
End Function


'simple qSort...picks the pivot at halfway point...

Public Function QSortN(ByVal vArray As Variant, _
                        Optional strCompareMode As VbCompareMethod = vbBinaryCompare, _
                        Optional tst As Boolean) As Variant

tst = False
On Error GoTo exitFunc
If Not IsArray(vArray) Then Exit Function
arrayType = VarType(vArray) - 8192
compareMeth = strCompareMode
Call recurseSort(vArray, LBound(vArray), UBound(vArray))
QSortN = vArray
tst = True

exitFunc:
arrayType = 0: pivot = Empty
tmpLow = 0: tmpHI = 0
tmpSwap = Empty
End Function

 

[chirp]

Also in regards to SHG's post, i agree in general terms but not so much about the specific numbers. it is a misrepresentation of the problem to state the number of combinations in a data set of n=200 would need such large numbers of iterations to complete. in the example case of random data from 1 to 1e6, the number of possible ways to reach certain values may well have a large average, but with smaller target values of 1 or 2 times, along with the numbers not being integers, but rather having some decimal component, the number of solutions could represent something of value.

also while the number of combinations is on the order of 10e60, you would only ever have to compute all those combinations if your target was: sum k=1 to n(k)

this would rarely be the case. also the number of solutions would be the sum of all the elements, which would be on the order of 10e11 not 10e10 unless i am mistaken.

so i agree that if you have a target that is equal to the sum of 200 elements, then you would have to deal with these large, large numbers, but in all likelihood the target would be somewhere below this upper limit, and thus, depending on how small it is, a reasonable time frame for computation could be achieved, coupled with the data having some decimal component, it is not completely unreasonable. the target range in the previous mentioned case would be: min(data) to sum(data), which would be something like 1 to 5e11. obviously any target in the range of 5e11 will have an impossibly huge number of possible combinations, however a target in the range of 1e6 would need exponentially less iterations, and would be feasible to complete.

however just with the code posted below, and a set of 200 random integers from 1 to 1,000,000 it takes about 4 hours to get 640,000 combinations that sum to a target value of 1,000,000.

that is a fairly significant computation time, and will increase exponentially as your target value increases.