Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

getting all combinations 1

Status
Not open for further replies.

557

Programmer
Oct 25, 2004
64
US
can someone tell me the logic to use for this problem

i have a table with about 1000 records. each record has many detail fields and an amount field. when the user gives a particular amount ,say 10000, i want to find all combinations of records in this table which will give me a sum of exactly this amount 10000. there may be 1 record or 2 records or 3 records or n records that give me this amount as sum. how do i get all the combinations in this table for this requirement?




 
When you say you have a table, is this in a database? Do you simply want to search the table for all entries where the amount is 10000?

If so, then use the SELECT statement, such as:
SELECT * FROM myTable WHERE amount='10000'

BB
 
557,

If you mean combinations that you would probably need to evaluate (obtain sum) as many as the array of 1000!/(k!(1000-k)!) combinations where k runs from 1 to 500, e.a.:

1000!/(1!*999!) + 1000!/(2!*998!) +...+1000!/(500!*500!)

Quite a bit...

vladk
 
557,

I gave you example of 1000 records, you have 10000!

vladk
 
I think you have to create a loop that will take Record 1, add Record 2, if it is < 1000, add record 3, if it is = 1000 stop, if it is >1000, remove record 2 etc....

Then start again with record 2.

But I am not sure this will give you all possibilities !
(if solution Record1 + Record2 + record25, you have to go again because maybe Recor1 + Record2+record26 is also a solution)

I do not think there is any "trick" to do this, you have to write the routine, which might be quite long to run depending on the number of record you have !

(You can speed up in not taking into account all the record >1000 for example, but that's all I can see ...)
 
It's a simple enough loop - the problem is that there are potentially 1000! answers, which is approx 4 x 10[sup]2567[/sup]

Unfortunately using the fastest current supercomputer, it will take about 3 x 10[sup]2530[/sup] times the expected life of the universe to go through them all!

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'If we're supposed to work in Hex, why have we only got A fingers?'

for steam enthusiasts
 
cbsm, i also had the same feeling. maybe a stack and recursion should be used to implement that logic, right?
 
Stack / recursion? Are you kidding? Did you look at johnwm's reply? You need to review the basic properties' of combinations

MichaelRed


 
Look at the formulas I provided and you will get feeling of the volume.
 
Johnwm gave 1000! which is a the # of permutations of 1000 items, not all possible combinations. All combinations of N things is simply 2 ti the Nth power because each item is either IN or OUT. However not every combination need be looked at after a certain sum exceeds the desired sum if all numbers are positive. This requires a recursive solution.

Compare Code
 
The following works as a VB Project but be warned that the maximum possible iterations is N^2 where N is number of numbers. That is the combination of N things taken R at a time from R = 0 To N. It comes down to "Each number is either IN or OUT, a binary choice. However, the algorithm will not proceed down a path when the Total has been exceeded.

Option Explicit
Private mIs() As Currency ' Numbers
Private mStr() As String ' Work
Private mnStr As Long '
Private mFinalTotal As Currency ' Total

Private Sub cmdRun_Click()
Dim i As Long
mStr = Split(txtNums.Text, ",")
ReDim mIs(UBound(mStr))
Dim k As Long
k = -1
For i = 0 To UBound(mStr)
If Len(mStr(i)) > 0 Then
k = k + 1
mIs(k) = CCur(mStr(i))
End If
Next
ReDim Preserve mIs(k)
ReDim mStr(UBound(mIs))
mnStr = -1
mFinalTotal = CLng(txtTotal.Text)
FindTotal -1, 0
End Sub

Private Sub FindTotal(ByVal i As Long, ByVal total As Long)
Dim sTotal As Long
Dim j As Long
Dim x As Long
For j = i + 1 To UBound(mIs)
sTotal = total + mIs(j)
mnStr = mnStr + 1
mStr(mnStr) = CStr(mIs(j))
If sTotal = mFinalTotal Then
For x = 0 To mnStr
Debug.Print mStr(x) & ",";
Next
Debug.Print ""
End If
If sTotal < mFinalTotal Then
FindTotal j, sTotal
End If
sTotal = sTotal - mIs(j)
mnStr = mnStr - 1
Next
End Sub

Private Sub txtTotal_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub

Select Case Chr(KeyAscii)
Case Is < "0", Is > "9"
KeyAscii = 0
End Select
End Sub
Private Sub txtNums_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If Chr(KeyAscii) = "," Then Exit Sub
Select Case Chr(KeyAscii)
Case Is < "0", Is > "9"
KeyAscii = 0
End Select
End Sub


Compare Code
 
I apologise if I exaggerated - if we take the conservative view that there are only 2[sup]1000[/sup] valid sums we are still looking at 10[sup]301[/sup] calculations, which at 10[sup]9[/sup] per second will still take substantially longer than the most optimistic forecast for the life of the universe

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first

'If we're supposed to work in Hex, why have we only got A fingers?'

for steam enthusiasts
 
But, assuming that the given Sum is far less than the sum of ALL the records, many of the paths in the Tree will never have to be visited because the running sum from "visited" nodes will have already exceeded the given sum, especially if the the amounts are sorted in descending sequence. If the entered sum is close to the total of all records or there are negative numbers then all bets are off.

Compare Code
 
JohnYingling,

While I greatly respect your abilities, I must (now) alos pay hoimage to your optimisim. When you generate a soloution based on assumptions re the data content of a general purpose procedure, your faith is not just greater than mine, it is more-or-less in opposition. I tend to believe the addage " ... if it CAN go awry IT WILL ... " usually, with at least some (always negative) consequences. There are numerous exercises in these fora and many of the 'tutorials' re VB(A). Many of them can easily be modified to show the (truth of) above adage. IF (and it really is a capital IF) you can either assure the data set(s) fit the assumption -or provide an alternative soloution for the data sets which do not meet the soloution I would hapily embrace it. Failure to do at least one of these seems to beg the question.




MichaelRed


 
johnyingling, thanks a lot. your program worked perfectly. the only issue was that if there were too many combinations, it takes too long. is there any way we can eliminate a lot of unwanted numbers??
 
Set the compiler optimization for fastest code. Unroll loops at least to sets of 10. Those are a couple of things to help speed up the code, but you're still working with a lot of iterations. But that's what you were told to begin with.

You can always put some kind of display for progress, like every 21 (some odd number so it looks like it's displaying each one) times through the loop. That will take more time, but the display will be a distraction to whoever is waiting for the processing to finish.

Lee
 
Remember, the search will take longer when the total you are looking for does not exist or as it gets closer to the total of all numbers (duh - the smaller the total, the fewer numbers). Finding all combinations takes longer than finding the first. There is no guarantee that it will ever stop for large values of N as has been noted. You could try sorting the numbers in descending order so that > Total will be reached sooner in the early going.

'' Speed it up some by taking out CStr until
'' an answer is found.
Option Explicit
Private mIs() As Currency ' Numbers
Private mStr() As String ' Work
Private mRes() As Currency ' Result[/b
Private mnStr As Long '
Private mFinalTotal As Currency ' Total

Private Sub cmdRun_Click()
Dim i As Long
mStr = Split(txtNums.Text, ",")
ReDim mIs(UBound(mStr))
Dim k As Long
k = -1
For i = 0 To UBound(mStr)
If Len(mStr(i)) > 0 Then
k = k + 1
mIs(k) = CCur(mStr(i))
End If
Next
ReDim Preserve mIs(k)
ReDim mStr(UBound(mIs))
ReDim mRes(UBound(mIs))
mnStr = -1
mFinalTotal = CLng(txtTotal.Text)
FindTotal -1, 0
End Sub

Private Sub FindTotal(ByVal i As Long, ByVal total As Long)
Dim sTotal As Long
Dim j As Long
Dim x As Long
For j = i + 1 To UBound(mIs)
sTotal = total + mIs(j)
mnStr = mnStr + 1
'''mStr(mnStr) = CStr(mIs(j))
mRes(mnStr) = mIs(j)

If sTotal = mFinalTotal Then
For x = 0 To mnStr
'''Debug.Print mStr(x) & ",";
Debug.Print Cstr(mRes(x) & ",";

Next
Debug.Print ""
End If
If sTotal < mFinalTotal Then
FindTotal j, sTotal
End If
sTotal = sTotal - mIs(j)
mnStr = mnStr - 1
Next
End Sub

Private Sub txtTotal_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub

Select Case Chr(KeyAscii)
Case Is < "0", Is > "9"
KeyAscii = 0
End Select
End Sub
Private Sub txtNums_KeyPress(KeyAscii As Integer)
If KeyAscii = 8 Then Exit Sub
If Chr(KeyAscii) = "," Then Exit Sub
Select Case Chr(KeyAscii)
Case Is < "0", Is > "9"
KeyAscii = 0
End Select
End Sub


Compare Code
 
Funny, I just answered almost the same question in the VB.NET forum: thread796-1008980

There, the poster was trying to find combinations of invoices which would match the amount of a check that the customer had sent in.

This is (I believe) a variation of the knapsack problem, which is NP Complete. These sorts of problems are characterized by processing time being exponential as the possible number of combinations go up. This certainly fits that definition!

Chip H.



____________________________________________________________________
Click here to learn Ways to help with Tsunami Relief
If you want to get the best response to a question, please read FAQ222-2244 first
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top