View Full Version : All permutations / combinations that meet certain criteria.


Cosmos75
07-14-2003, 01:47 PM
Not sure if this belongs here in Queries or Modules and VBA but I'll take my chances!! As I have no idea how this would be acomplished with queries, I decided to try my luck here...

I have this info

tblEmissionUnit
UnitID (PK)
UnitDesc (Text)
EmissionRate1 (Number)
EmissionRate2 (Number)
EmissionRate3 (Number)
EmissionRate4 (Number)

tblEmissionStandard
EmissionStandardID (PK)
EmissionStandard1 (Number)
EmissionStandard2 (Number)
EmissionStandard3 (Number)
EmissionStandard4 (Number)

- TblEmissionUnit represents an Emission Unit and it’s Emission Rates (four of them).
- TblEmissioniStandard represents the permissible emission limit for each respective Emission Rate (Cumalitive). Only one record for this table.

I want to have a reports of all the combinations of units where the SUM of EmissionRate1 is less than it’s respective Standard (for all EmissionRate 1 through 4).

e.g. EmissionRate1 (Unit 1) + … + EmissionRate1 (Unit X) <= EmissionStandard1

Need ALL combinations that are <= EmissionStandard1 (e.g. Unit1+ Unit3+ Unit8).

Is there anyway to do this?

ozinm
07-14-2003, 04:34 PM
I'm not sure I get you completely, but it sounds like you're gonna need a pivot table.

pdx_man
07-14-2003, 05:02 PM
Please post a more populated recordset example, like:


UnitID UnitDesc ERate1 ERate2 ERate3 ERate4
4 DescX 20 25 32 45
5 DescX 40 25 38 40
6 DescX 50 20 31 42
7 DescX 20 35 32 46
8 DescX 20 25 30 45

EStdID EStd1 EStd2 EStd3 EStd4
1 65 55 70 100


So then, you want a report that would give you:

Standard1 of 65 yields these combinations of units
4
4,5
4,7,8
5
5,7
5,8
6
7
7,8
8

Standard2 of 55 yields these combinations of units
4
4,5
4,6
:
:

Is this what you are after?

Cosmos75
07-15-2003, 06:50 AM
pdx_man,

Sorry about not posting any dummy data.

Yes, You've got what I'm after perfectly!

My guesss as to what needs to be done is to have a query (?) that creates all possible the permutations.
Then somehow add up the field for each permutation and check to see if it's greater than the respective EmissionStandard and choose only those that aren't.

EDIT: Now that I think about it, what about if I need to allow for repeatable combinations.

e.g. I could have Unit 4 * 3 = 20 * 3 <= 60
Or even Unit 4 * 2 = 20 * 2 = 40 <= 60
Or even Unit 4 + Unit 4 + Unit 7 = 20 + 20 + 20 <= 60

Cosmos75
07-15-2003, 07:30 AM
It's been a long time since I did statistics!

Combinations: If one has 5 different objects (e.g. A, B, C, D, and E), how many ways can they be grouped as 3 objects when position does not matter (e.g. ABC, ABD, ABE, ACD, ACE, ADE are correct but CBA is not ok as is equal to ABC) - answer is 10 ways. Formula: 5C3 = 5!/((5-3)!*3!) = 5*4*3*2*1/(2*1*3*2*1) = 5*2 = 10

Permutations: Given that position is important, if one has 5 different objects (e.g. A, B, C, D, and E), how many unique ways can they be placed in 3 positions (e.g. ADE, AED, DEA, DAE, EAD, EDA, ABC, ACB, BCA, BAC etc.) - answer is 60 ways. Formula: 5P3 = 5!/(5-3)! = 5*4*3*2*1/(2*1) = 5*4*3 = 60

Repeatable: Given that position is important, if one has 5 different objects, e.g. A, B, C, D, and E - but many copies of each, how many unique ways can they be placed in 3 positions with up to 3 copies of any object (e.g. AAA, ABB, CCC, EEC, CEE etc.) - answer is 125 ways. Formula: 5R3 = 5^3 = 125

http://www.andrews.edu/~calkins/math/webtexts/prod02.htm

pdx_man
07-15-2003, 12:32 PM
This is not going to be solved soley with a query, for sure. You are going to have to use code where you loop through every possible combination that is valid (repeatable ... unique placement ...) for your cause. Store the matches in either an array or a tabledef for later use.

Cosmos75
07-15-2003, 12:40 PM
I've got a query that is does only part of the job.

SELECT a.UnitID, tblUnit.UnitID, a.EmissionRate1, tblUnit.EmissionRate1, [a.EmissionRate1]+[tblUnit.EmissionRate1] AS [Sum]
FROM tblUnit AS a, tblUnit, tblEmissionStandard;

This'll return all combinations of two units and sum EmissionRate1.

But I'd have to know what the maximum numbers or units that could be used at any one time and create X number of queries.
Not very apealing.
:(

Guess I did post in the correct section, huh?

Would the solution to this recursive? (Not that I know how do do that)

Ok, to get me started, how to I retrieve records from a table and then store records into an array? I'll try to get at least the logic behind what the code should do down.

Sigh... this is going to be difficult, isn't it?!
:confused:

WayneRyan
07-15-2003, 01:03 PM
Cosmos,

What If ...

For Unit1 = 0 to 1
For Unit2 = 0 to 1
For Unit3 = 0 to 1
For Unit4 = 0 to 1
For Unit5 = 0 to 1
If Unit1 * Unit1Value + Unit2 * Unit2Value ... > Std1
Next Unit5
Next Unit4
Next Unit3
Next Unit2
Next Unit1

Could it be that something simple like that, if your unitvalues
were in an array. If so we're there.

In the interim, I'll think about it.

Wayne

WayneRyan
07-15-2003, 01:34 PM
Cosmos,

Enhanced a little ...


Dim Units(8, 5) As Long
Dim Stds(5) As Long

Dim dbs As Database
Dim rst As RecordSet
Dim sql As String

Set dbs = CurrentDb
'
' Get all emissions ...
'
sql = "Select * From tblEmissionUnit Order by UnitID"
Set rst = dbs.OpenRecordset(sql)
While Not rst.EOF and Not rst.BOF
Units(rst!UnitID, 1) = rst!UnitID
Units(rst!UnitID, 2) = EmissionRate1
Units(rst!UnitID, 3) = EmissionRate2
Units(rst!UnitID, 4) = EmissionRate3
Units(rst!UnitID, 5) = EmissionRate4
rst.MoveNext
Wend

'
' Get all Standards ...
'
sql = "Select * From tblEmissionUnit Order by UnitID"
Set rst = dbs.OpenRecordset(sql)
While Not rst.EOF and Not rst.BOF
Stds(1) = rst!EmissionStandardID
Stds(2) = rst!EmissionStandard1
Stds(3) = rst!EmissionStandard2
Stds(4) = rst!EmissionStandard3
Stds(5) = rst!EmissionStandard3
rst.MoveNext
Wend

For Std = 1 to 4
For Unit1 = 0 to 1
For Unit2 = 0 to 1
For Unit3 = 0 to 1
For Unit4 = 0 to 1
For Unit5 = 0 to 1
For Unit6 = 0 to 1
For Unit7 = 0 to 1
For Unit8 = 0 to 1
If (Units(std, 2) * Unit1) + (Units(std, 3) * Unit2) + (Units(std, 4) * Unit3) + _
(Units(std, 5) * Unit4) > Stds(std) Then
MsgBox("The ones that are 'on' are bad.")
End If
Next Unit8
Next Unit7
Next Unit6
Next Unit5
Next Unit4
Next Unit3
Next Unit2
Next Unit1
Next Std


hth,
Wayne

Cosmos75
07-16-2003, 11:50 AM
Thank you all for your replies. I guess I had not thought the problem all the way through.

WayneRyan,

I'll look over what you have posted and try to digest it. (key word: try!)
:p

pdx_man
07-16-2003, 05:14 PM
I, myself, would probably do a recursive call to find all the permutations, then populate a different recordset or output file with the one that meet the criteria. (Assuming you don't have a finite number of units) You would have to pass the running total and the Standard for that unit, as well. Look up some examples on the web using keywords ... recursive loop all combinations or something of the like. This should also point you to some iterative solutions, too, if you are not comfortable with recursion.

Cosmos75
07-22-2003, 07:57 AM
I've got a working Excel version.

I've got two sheets (Data & Results)
Cell A1:A5 = 1,2,3,4, and 5
Cell D5 is the max number of units to include in a permutation (with repitition)


Sub Permutation()

RCount = Sheets("Data").Range("D5").Value

'Calculate number of permutations for RCount items'
If RCount > 1 Then
For i = 1 To RCount
AddR = RCount ^ i
SumR = SumR + AddR
Next i
Else
SumR = RCount
End If

MsgBox "For " & RCount & " engines, the possibilites are: " & SumR

' Get start time.'
sngStart = Timer


Application.ScreenUpdating = False
Application.DisplayStatusBar = True

'set to row for first record to 1'
pasteRow = 1

'Set up number it items in permutation '
'(RCount = 1 -> 1, 2, 3...; RCount = 2 -> 11, 12, 13, 14, ...'
For countcol = 1 To RCount

'Set up number of rows for each RCount set.'
'RCount = 1 -> should have RCount^1 rows, '
'RCount = 2 -> Should have RCount ^ 2'
For rw = 1 To RCount ^ countcol

'To start pasting cells from left most column to rightmost column'
For col = 1 To countcol

'For current column, every [RCount ^ (countcol - current column)], '
'the copied cell should shift to the next cell'
'from 1 -> 2 -> 3-> ... -> RCount'
'and that that pattern repeats '
'every [RCount ^ (countcol - current column +1 )] rows'
'this is used to just figure out what pattern it is on.'
'e.g. when RCount = 5, countcol = 4, row =51, column = 3, '
'then it should be the same as row = 1.'
s = -1
testS = s * (RCount ^ (countcol - col + 1))
While testS < rw
s = s + 1
testS = s * (RCount ^ (countcol - col + 1))
Wend

'Row 51 should be the same as row 1 (see example above), '
'this calculates current row as 1'
testrw = rw - ((s - 1) * (RCount ^ (countcol - col + 1)))

'Figure out which data row to copy'
n = 1
testcon = (n * (RCount ^ (countcol - col)))
While testcon < testrw
n = n + 1
testcon = (n * (RCount ^ (countcol - col)))
Wend

Sheets("Data").Range("A" & n).Copy
Sheets("Results").Select
Range("A1").Select
Selection.Offset(pasteRow - 1, col - 1).Select
ActiveSheet.Paste

Next col

'increase row to copy to by one.'
pasteRow = pasteRow + 1
'Calculate percent done'
percentdone = Round(100 * (pasteRow / SumR), 0)
'Update status bar to show progress'
Application.StatusBar = "Producing # " & pasteRow & " of " &_
SumR & ". " & percentdone & " % complete"
Next rw

Next countcol

' Get end time.'
sngEnd = Timer

' Elapsed time.'
sngElapsed = Format(sngEnd - sngStart, "Fixed")
MsgBox ("This took " & sngElapsed & " seconds to finish...")


MsgBox pasteRow - 1 & " total combinations produced!",_
vbInformation, "Finished!"

Application.StatusBar = ""
Application.DisplayStatusBar = True
Application.ScreenUpdating = True

End Sub


Could I use the same logic to create records in a table.

Sheets("Data").Range("A" & n).Copy
Sheets("Results").Select
Range("A1").Select
Selection.Offset(pasteRow - 1, col - 1).Select

becomes something like (please note this is not reall code just my idea of how it might work)

tblUnit.Field(1) & Record(n) Copy
tblNEW.Field(col-1),Record (pasteRow -1) Insert

the one problem with this is that is treats
1,1,3 the same as 3,1,1
but to me it only means 2 *1 and 1 *3 at the same time.

Am working on getting to just produced each unit only once in a row (Combinations without repetition). But thought this might be interesting.. (Maybe not..)

Then it’s on to Combinations (No repeat) and Permutations (No repeat).

This has turned more into a coding exercise that anything else for me.
:)

Cosmos75
07-24-2003, 10:06 AM
Solution provided by JasonM at www.accessvba.com

I have abstracted the problem to make it more interesting (for myself, at least).

Using the following code (just save it all into a new module), you can create a query that will derive combinations or permutations, with or without repetitions.
Syntax:
CreateCPQuery(sField As String, sTable As String, ct As ComboType, k As Integer)

Where ct is:
ctCombination
ctCombinationWithRepetition
ctPermutation
ctPermutationWithRepetition

and k is the number of elements in each group.

Example:
Call CreateCPQuery ("Description", "tblItems", ctPermutation, 3)

Will create a query named "tblItems_Description_P_3" that shows all 3 item permutations of the field "Description" in the table "tblItems".

Notes:
No error handling or sanity checks.
The items need to be "sortable", as combinations depend on < and <= operators.
It would not be difficult to take this further, and create a union of queries that handled a series of combinations/permutations.

If I made an error, please let me know.

Option Compare Database
Option Explicit

Public Enum ComboType
ctPermutation
ctPermutationWithRepetition
ctCombination
ctCombinationWithRepetition
End Enum

Public Function CreateCPQuery(sField As String, sTable As String, ct As ComboType, k As Integer)
Dim sSQL As String
Dim sQueryName As String
Dim sct As String

sSQL = cmbSQL(sField, sTable, ct, k)

Select Case ct
Case ctCombination
sct = "C"
Case ctCombinationWithRepetition
sct = "CR"
Case ctPermutation
sct = "P"
Case ctPermutationWithRepetition
sct = "PR"
End Select

sQueryName = sTable & "_" & sField & "_" & sct & "_" & CStr(k)

CurrentDb.CreateQueryDef sQueryName, sSQL

End Function

Private Function cmbSQL( _
sField As String, sTable As String, ct As ComboType, k As Integer) _
As String

Dim sSQLSelect As String
Dim sSQLFrom As String
Dim sSQLWhere As String
Dim sSQL As String
Dim sFieldName As String
Dim sTableName As String

Dim i As Integer
Dim j As Integer

'SELECT and FROM'

sSQLSelect = "SELECT "
sSQLFrom = "FROM "

For i = 0 To (k - 1)
sTableName = sTable & "_" & i
sFieldName = sTableName & "." & sField

sSQLSelect = sSQLSelect & sFieldName & " ,"
sSQLFrom = sSQLFrom & sTable & " AS " & sTableName & " ,"
Next i

sSQLSelect = Left$(sSQLSelect, Len(sSQLSelect) - 1)
sSQLFrom = Left$(sSQLFrom, Len(sSQLFrom) - 1)

'WHERE'
sSQLWhere = "WHERE"
Select Case ct
Case ctPermutationWithRepetition

Case ctPermutation
For i = 0 To (k - 2)
sSQLWhere = sSQLWhere & " ("
For j = (i + 1) To (k - 1)
sSQLWhere = sSQLWhere & "(" & sTable & "_" & i & "." & sField & " <> " & sTable & "_" & j & "." & sField & ") AND "
Next j
sSQLWhere = Left$(sSQLWhere, Len(sSQLWhere) - 5) & ") AND "
Next i

Case ctCombination
For i = 0 To (k - 2)
sSQLWhere = sSQLWhere & " (" & sTable & "_" & i & "." & sField & " < " & sTable & "_" & i + 1 & "." & sField & ") AND "
Next i

Case ctCombinationWithRepetition
For i = 0 To (k - 2)
sSQLWhere = sSQLWhere & " (" & sTable & "_" & i & "." & sField & " <= " & sTable & "_" & i + 1 & "." & sField & ") AND "
Next i

End Select
sSQLWhere = Left$(sSQLWhere, Len(sSQLWhere) - 5)

sSQL = sSQLSelect & vbCrLf & sSQLFrom & vbCrLf & sSQLWhere
cmbSQL = sSQL

End Function

I noticed you can use the following logic for the combinatorics:

For all, take a cartesian product across k number of tables.

For Permutation w/Repetition, you are done. (easy enough).

All others, need some sort of WHERE clause.

For Combination, each field must be < the next field
For Combination w/Repetition, each field must be <= the next field
For Permutation, each field must be <> to all following fields. (the hardest one).

Now, you could use non-equi joins for permutations instead, but that would clutter up the FROM clause. I think it's better to simply deal with this in the WHERE clause, since we have to create a unique WHERE clause (or lack of one) for each ct anyway. This removes the need for 2 Select...Case structures.

From there, it's just building the SQL. It reduces code to have the first table aliased to TableName_0, because then you can treat it the same as all other tables inside a loop. This removes the need for an If...Then inside each loop.

It's also convinient to handle building the SELECT and FROM clauses inside the same loop.

With careful use of spaces in the WHERE clause, we can move the start of sSQLWhere and the stripping of the last " AND " to outside of the Select...Case structure, rather than doing it for each case (as it was earlier).

This is because "WHERE" and " AND " have the same number of characters, so in the case of ctPermutationWithRepetition, we are stripping out the "WHERE". I didn't see this at first, and it allows the removal of a half-dozen lines.

Cosmos75 - I am attaching a sample db (Access 97). I have added a form which is used to enter the parameters and a changed the code a bit to take the ct parameter from a combobox.

pdx_man
07-28-2003, 01:28 PM
Yes, this gives you a solution if you must use all of the elements ...

Your requirements may not include needing all of the elements. You would lose a lot of possiblities if you took an approach like this...

Did you do the search I mentioned above. I found a lot of neat info. Have you found a solution to the problem, or are you just checking out and learning about combinatorics?

ozinm
08-21-2003, 08:02 PM
I know you posted this question a while ago but I was trawling through the help in access for something else and found this little snippet (below).
As soon as I read I remembered your question.

from the MSAccess 2002 help:

Cross-product or Cartesian product joins

If tables in a query aren't joined to one another, either directly or indirectly, Microsoft Access doesn't know which records are associated with which, so it displays every combination of records between the two tables. Therefore, if each table had 10 records in it, the query's results will contain 100 records (10X10). This result set of every possible combination is called a cross product or Cartesian product. These queries might take a long time to run and ultimately might produce less meaningful results.


(Without re-reading what you were orginally after) this might do the job a lot simpler.
Better late than never ;)

pdx_man
08-22-2003, 09:53 AM
The only problem with this, is that it doesn't solve the problem. Yes, it will give you all combinations of all of the elements, but there is a subset here that is being ignored.

He needs to know if any combination of items would equal a threshold. Using the cartesian product method, you would have to look at combinations using all of the elements. But using 2 of the, let's say, 5 elements would satisfy the condition. We would never get that set using what has been posted here so far.

So, again, lets say we have a 6 element set.
{1, 2, 3, 4, 5, 6}
Question:
List the combinations that sum to 6.
{1, 2, 3}
{2, 4}
{1, 5}
{6}
Using a cartesian product, you would never find sets of data that worked.
You would also want non-repeating sets. We would want to exclude:
{2, 1, 3}
{2, 3, 1}
{3, 1, 2}
:
:

WayneRyan
08-22-2003, 05:11 PM
pdx or cosmos,

Does my no-brainer that I posted work? It seemed to me that
with the 0 and 1 values, it tested all possible combinations.

It is not an elegant approach. It is not a scientific approach.
It is not a well thought out approach. But I think it works.

Doesn't it.

Wayne

pdx_man
08-22-2003, 10:26 PM
Yes Wayne, it will work, but it is still not the best solution. But for the purposes here. Should work fine. The reason that it isn't the best, is that it will continue to check combinations where there can't possibly be a solution. ie If UnitValue 2 + UnitValue3 > std1, don't check any more combinations using 2 & 3.

The solution that I have been trying to elude to uses a recursive procedure. You push each element onto the stack that when summed, meets the < std1 criteria until either you run out of elements, or you go past the std1. Don't really see recursion used much any more these days, which, to me is suprising, what with memory being in such abundance as compared to the days of yore. Of course, all recursive procedures can be written linearly, but, I'll save that for Cosmos. Can't just give away all the answers here. :D

WayneRyan
08-22-2003, 10:33 PM
pdx_man,

I knew that you'd give me a reply.

For my CSC degree "a few" years ago I took some very heavy
duty Calculus, Numerical Analysis and Stat courses. Since
then I have tried to avoid thinking too deeply along these
subjects.

Sometimes you can just let the computer take the "brute force"
approach and it will give you the answer.

The "solution" that I gave just seemed "intuitive" and I was
just wondering if it was viable.

Thanks again.

btw, I'm having a very exciting Friday night too! Oh well...

Also, by the way, I did get to write something recursive for
VBAHole. It was sort of fun. We could have used you on this
one:

http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=51083&highlight=recursion+wayne

Wayne

raskew
08-31-2003, 10:54 AM
This was an interesting challenge. Provided I understand the problem correctly, here's a possible working solution, written in Access 97.



Oops-found a glitch that was deleting some combinations that shouldn't have been.

If you're viewing the code:

In the declarations change
Dim intASC As Integer
to
Dim intASC As Long

In Step 3 change
intASC = intASC + Asc(Mid(strHold, j, 1))
to
intASC = intASC + Asc(Mid(strHold, j, 1)) ^ 2

raskew
09-03-2003, 03:34 PM
Mag-

Are you sure this is thread you want to plug into?

Maybe think about deleting your response (unless I've totally missed the point) and creating a new thread with your question.

Best wishes,

Bob