All permutations / combinations that meet certain criteria.

[Cosmos75]

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]

I'm not sure I get you completely, but it sounds like you're gonna need a pivot table.

 

[pdx_man]

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]

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]

Combinations NOT Permutations MAYBE Permutations with Repeated Elements

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]

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]

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?!

 

[WayneRyan]

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]

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]

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!)

 

[pdx_man]

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]

Excel Code

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 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]

Create Query Code - Don't read if you are trying to solve this on your own!

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]

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]

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]

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]

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]

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.

 

[WayneRyan]

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...p?s=&threadid=51083&highlight=recursion+wayne

Wayne

 

[raskew]

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