All possible integer combinations, stored in a table 3

[GKIL67]

Hello, this is quite complex...
I'm trying to come up with a function that for N numbers generates all possible combination in sets of K of them. The numbers N are not always sequential, they appear only once and they are fed as a string parameter, separated by ",". The K is not always known and it is passed as a parameter. Then the results-combinations are added in a Table, however the columns are every time adjusted according to K.
Example:
Combinations(K=5, N="1,2,22,33,35,39,45,47,49,51")
produces a total of 252 combinations-records which are listed in a Table with fields Field1 thru Field5.

Thank you in advance for any valuable feedback!

 

[dhookom]

I'm not sure I understand the logic here but assuming you create a table tblN with a single numeric field N and values 1 to 100. You could us a little DAO code to update the SQL property of a saved query QN then build SQL to run a maketable query. Assuming you have a form that has two text boxes:
txtN for the numbers separated by a comma
txtK for the K value

Private Sub cmdBuildQuery_Click()
    Dim qd As DAO.QueryDef
    Dim intI As Integer
    Dim strSQL As String
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    Set qd = CurrentDb.QueryDefs("QN")
    qd.SQL = "SELECT N FROM tblN WHERE N IN (" & Me.txtN & ")"
    Set qd = Nothing
    strSelect = "SELECT QN.N "
    strFrom = "FROM QN "
    strWhere = "WHERE QN_1.N < QN.N "
    For intI = 1 To Me.txtK - 1
        strSelect = strSelect & ", QN_" & intI & ".N AS N" & intI & " "
        strFrom = strFrom & ", QN AS QN_" & intI & " "
        If intI < Me.txtK - 1 Then
            strWhere = strWhere & " AND QN_" & intI + 1 & ".N< QN_" & intI & ".N "
        End If
    Next
    strSQL = strSelect & " INTO tblCombinations " & strFrom & strWhere
   ' Debug.Print strSQL
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
End Sub

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

To verify
S = the set of values from which to choose from
S = {1,2,3,4,5,6,7,8,9} no 0
R = The number of values to choose
K = The max value to choose

So if K = 5
R = 1,2,3,4,5

So you want all unique
from S choose 1
from S choose 2
from S choose 3
from S choose 4
from S choose 5

So what does this mean?
"The numbers N are not always sequential, they appear only once and they are fed as a string parameter, separated by ","

Who is feeding what, where?
Are you saying you want to pass a function K and return the set returned as a string?

"which are listed in a Table with fields Field1 thru Field5"
Are you saying you already have the combinations in a table where each fiield represents R. If that the case this is much easier easier because then I if you pass K = 6 then I return the values from field1 - field6

Field 1 Field 2
1 11
2 12
3 13
4
5
6
7
8
9
to
99

If you want a generic function so you can pass large K, I can not imagine you prepopulating a table in that format. And that design would be wrong. If I know that K will never be greater than say 10. I would run code to populate a table first that looked like

TblCombinations
intK
combination
K N
1 1
..
1 9
2 11
..
2 99
3 111
..
3 999

Running code to populate the above table would be easily if the limit to K is known.
Then drawing from this table is realy easy because if I want K = 5 then I return all records where the field K is less than 5.

Please provide more details

 

[MajP]

If you know the limit to what your K would ever be, then you could be the following function just adding K nested loops.
Here is an example of 4 loops, but with a little cutting and pasting your could expand to maybe 10
After that it would hard to manage the code, but it is unlimited.

If K can get very big or the max is unknown then you will have to build a recursive function. It can be done, but I would have

to think about it. It is a lot quicker to me to do the nested loops

Public Function getKcombinations(K As Integer) As String
  Dim intCount As Integer
  For intCount = 1 To K
    getKcombinations = getKcombinations & ";" & getS_choose_R(intCount)
  Next intCount
  getKcombinations = Right(getKcombinations, Len(getKcombinations) - 1)
End Function

Public Function getS_choose_R(R As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim K As Integer
  Dim l As Integer
  ' keep going to max
  
  For i = 1 To 9
    If R = 1 Then getS_choose_R = getS_choose_R & ";" & i
    If R > 1 Then
       For j = i To 9
         If R = 2 Then getS_choose_R = getS_choose_R & ";" & i & j
         If R > 2 Then
            For K = j To 9
              If R = 3 Then getS_choose_R = getS_choose_R & ";" & i & j & K
              If R > 3 Then
              'Keep adding loops
              For l = K To 9
                  getS_choose_R = getS_choose_R & ";" & i & j & K & l
              Next l
              End If
            Next K
         End If
      Next j
    End If
 Next i
 getS_choose_R = Right(getS_choose_R, Len(getS_choose_R) - 1)
End Function

Is this the output you want?

debug.print getKcombinations(4)


1;2;3;4;5;6;7;8;9;11;...8889;8899;8999;9999

 

[GKIL67]

Thank you both, let me explain my inquiry. The function is used to find all ways to choose K out of M items. For example, KchooseM(3,"1,2,3,4,5") where K=3 and M="1,2,3,4,5" returns a total of 10 unique combinations:
1. 1,2,3
2. 1,2,4
3. 1,2,5
...
9. 2,4,5
10. 3,4,5

Then I'd like to run a make table query by using DAO code, create a table having three (K=3) columns and store these combinations, i.e. Clmn1=1,1,1...2,3 Clmn2=2,2,2...4,4 Clmn3=3,4,5...5,5 for a total of 10 records for the KchooseM(3,"1,2,3,4,5").

Of course the hard thing is the recursiveness since K can be anything like 3, 5, 6 while the expected values of M are about 100.

To calculate the number of all possible combinations I use these functions:

Public Function Fact(ByVal bNum As Integer) As Double
Dim I As Double
  If bNum < 0 Then Exit Function
    Fact = 1
  For I = 1 To bNum
    Fact = Fact * I
  Next
End Function

Public Function Combinations(ByVal n As Integer, ByVal k As Integer) As Double
Combinations = Fact(n) / (Fact(k) * Fact(n - k))
End Function

So both replies approached the solution but how can we finalized it?

 

[MajP]

Again I would not build a table as you suggest. You are making it way too hard. The table should look like this

tblCombinations
comboID
SequencePosition
SequenceValue

So all you ever need is one table.
So your data for
1. 1,2,3
2. 1,2,4
3. 1,2,5

is stored as
1 1 1 (First combo, in first position is a 1)
1 2 2
1 3 3 (First combo, 3 position is a 3)
2 1 1
2 2 2
2 3 4
3 1 2
3 2 2
3 3 5 (Third combo, 3 position is a 5)

Then you can write a single cross tab query regardless of the K

TRANSFORM 
  First(tblCombinations.sequenceValue) 
AS 
  FirstOfsequenceValue
SELECT 
  tblCombinations.combinationID
FROM 
  tblCombinations
GROUP BY 
  tblCombinations.combinationID
PIVOT 
  tblCombinations.sequencePosition;

So if this is my tblCombinations:

combinationID	sequencePosition sequenceValue
0	1	1
0	2	2
0	3	3
1	1	1
1	2	2
1	3	4
2	1	1
2	2	2
2	3	5
3	1	2
3	2	3
3	3	4
4	1	2
4	2	3
4	3	5
5	1	2
5	2	4
5	3	5
6	1	3
6	2	4
6	3	5

Then my crosstab looks like

ID      1       2       3

0       1       2       3
1       1       2       4
2       1       2       5
3       2       3       4
4       2       3       5
5       2       4       5
6       3       4       5

So here is the code to populate the table given a string of values

Public Sub loadComboTable(strCombos As String, K As Integer)
  Dim strSql As String
  Dim aDigits() As String
  Dim intCount As Integer
  Dim intComboID As Integer
  Dim intPosition As Integer
  aDigits = Split(strCombos, ",")
  'clear out old data
  strSql = "DELETE * from tblCombinations"
  CurrentDb.Execute strSql
  For intCount = LBound(aDigits) To UBound(aDigits)
    intPosition = intPosition + 1
      strSql = "INSERT INTO tblCombinations (combinationID,SequencePosition,SequenceValue) "
      strSql = strSql & "Values (" & intComboID & "," & intPosition & "," & aDigits(intCount) & ")"
      CurrentDb.Execute strSql
    If intPosition = 3 Then
      intPosition = 0
      intComboID = intComboID + 1
    End If
  Next intCount
End Sub

Public Sub testpop()
  Dim str As String
  str = "1,2,3,1,2,4,1,2,5,2,3,4,2,3,5,2,4,5,3,4,5"
  loadComboTable str, 3
End Sub

So my question still is
1) DO you have the function that returns the combinations or are you looking for the function?
2) If you do not have the function do you have a Max limit for K.? So far I have heard 6. Does it have a known max limit.

If you are looking for a function and you know the limit on K, I can quickly modify the above function if you need a function for the combinations. I misread your post and I see that you provide M into the function as a parameter. So my example was wrong, but it can be easily modified. If the limit of K is not known, it will take me some time to get a recursive function. I know how to do the Permutations recursively, just not the combinations (without replacement).

 

[dhookom]

I assumed the solution I provided resulted in a table of the appropriate number of fields and records. I didn't review all 252 records but they seemed like it was exactly what you wanted. Did you try it? I pulled values from controls on a form but you could just as easily create a function with 2 arguments.

Duane
Hook'D on Access
MS Access MVP

 

[MajP]

Duane,
I did not get your solution at first, but it is very slick. You return 120 answers not 252 and that is the correct solution.

N choose R without repitition and without order being important is:
N!/(R!(N-R)!)

3628800 / (30240)
= 120

So your solution does it all.

Here is a more generic version and changed the < to > so that the columns are in ascending order.

Public Sub buildquery(strN As String, K As Integer)
    Dim qd As DAO.QueryDef
    Dim intI As Integer
    Dim strsql As String
    Dim strSelect As String
    Dim strFrom As String
    Dim strWhere As String
    
    Set qd = CurrentDb.QueryDefs("QN")
    qd.SQL = "SELECT N FROM tblN WHERE N IN (" & strN & ")"
    Set qd = Nothing
    strSelect = "SELECT QN.N "
    strFrom = "FROM QN "
    strWhere = "WHERE QN_1.N > QN.N "
    For intI = 1 To K - 1
        strSelect = strSelect & ", QN_" & intI & ".N AS N" & intI & " "
        strFrom = strFrom & ", QN AS QN_" & intI & " "
        If intI < K - 1 Then
            strWhere = strWhere & " AND QN_" & intI + 1 & ".N > QN_" & intI & ".N "
        End If
    Next
    strsql = strSelect & " INTO tblCombinations " & strFrom & strWhere
    DoCmd.SetWarnings False
    DoCmd.RunSQL strsql
    DoCmd.SetWarnings True
End Sub

Here is a test

Public Sub testbuildquery()
  buildquery "1,2,22,33,35,39,45,47,49,51", 3
End Sub

And it build the following table:

N	N1	N2
1	2	22
1	2	33
1	2	35
1	2	39
1	2	45
1	2	47
1	2	49
1	2	51
1	22	33
1	22	35
1	22	39
1	22	45
1	22	47
1	22	49
1	22	51
1	33	35
1	33	39
1	33	45
1	33	47
1	33	49
1	33	51
1	35	39
1	35	45
1	35	47
1	35	49
1	35	51
1	39	45
1	39	47
1	39	49
1	39	51
1	45	47
1	45	49
1	45	51
1	47	49
1	47	51
1	49	51
2	22	33
2	22	35
2	22	39
2	22	45
2	22	47
2	22	49
2	22	51
2	33	35
2	33	39
2	33	45
2	33	47
2	33	49
2	33	51
2	35	39
2	35	45
2	35	47
2	35	49
2	35	51
2	39	45
2	39	47
2	39	49
2	39	51
2	45	47
2	45	49
2	45	51
2	47	49
2	47	51
2	49	51
22	33	35
22	33	39
22	33	45
22	33	47
22	33	49
22	33	51
22	35	39
22	35	45
22	35	47
22	35	49
22	35	51
22	39	45
22	39	47
22	39	49
22	39	51
22	45	47
22	45	49
22	45	51
22	47	49
22	47	51
22	49	51
33	35	39
33	35	45
33	35	47
33	35	49
33	35	51
33	39	45
33	39	47
33	39	49
33	39	51
33	45	47
33	45	49
33	45	51
33	47	49
33	47	51
33	49	51
35	39	45
35	39	47
35	39	49
35	39	51
35	45	47
35	45	49
35	45	51
35	47	49
35	47	51
35	49	51
39	45	47
39	45	49
39	45	51
39	47	49
39	47	51
39	49	51
45	47	49
45	47	51
45	49	51
47	49	51

Duane, very slick. Here is a star.

 

[GKIL67]

It took me a while to follow thru, Duane's tblN was a puzzle at first so I didn't pay much attention but then I understood why MaJP called it slick... Thank you both Gens, however there are still these two(2) issues:

1. I'm still looking for a generic function, table-free as much as possible, that would return the combinations (NOT permutations), as MajP pointed above. The results could be directed let's say to a collection and printed in a msgbox. To summarize it, the function has to be like:
KchooseM(strN As String, K As Integer) where K<=10 and StrN holds the numbers to be combined (not more than 100 unique values).

2. I got MajP's last suggestion (refining Duane's code) working in my form, however when I try to execute and display the results of tblCombinations in an embedded form (main form has the txtK and txtStrN) I get the Run-time error 3211 "The database engine could not lock table 'tblCombinations' because it is already in use by another person or process."
How can I overcome this error?

Thank you!

 

[MajP]

The table needs to be closed in order to execute. So have a small input form with a button to execute. Call the buildquery sub, then call a docmd.open form. Make the display form modal so that you have to close it to run another buildQuery.

If I get time I will see if I can build a generic function. I searched the web for some code, but they are all different than your case which is: combinations, without replacement, order does not matter, varying N). They are all recursive calls which takes a little more thought.

 

[MajP]

This is not eloquent, but it took about 10 minutes to do instead of trying to do a recursive function. There are five levels here. It would take you about another ten to 15 minutes to put the other six nested loops. It is basically a cut and paste job

Public Function getN_choose_K(N As String, K As Integer)
  Dim i As Integer
  Dim j As Integer
  Dim l As Integer
  Dim m As Integer
  dim n as integer
  dim o as integer
  dim p as integer
  dim q as integer
  dim r as integer
  dim s as integer
  Dim aN() As String
  aN = Split(N, ",")

  
  For i = LBound(aN) To UBound(aN)
    If K = 1 Then getN_choose_K = getN_choose_K & ";" & aN(i)
    If K > 1 Then
       For j = i + 1 To UBound(aN)
         If K = 2 Then getN_choose_K = getN_choose_K & ";" & aN(i) & "," & aN(j)
         If K > 2 Then
            For l = j + 1 To UBound(aN)
              If K = 3 Then getN_choose_K = getN_choose_K & ";" & aN(i) & "," & aN(j) & "," & aN(l)
              If K > 3 Then
              ' Add remaining nested loops here
              For m = l + 1 To UBound(aN)
                  getN_choose_K = getN_choose_K & ";" & aN(i) & "," & aN(j) & "," & aN(l) & "," & aN(m)
              Next m
              End If
            Next l
         End If
      Next j
    End If
 Next i
 getN_choose_K = Right(getN_choose_K, Len(getN_choose_K) - 1)
End Function

Public Sub testgetNchooseK()
  Debug.Print getN_choose_K("1,2,22,33,35,39,45,47,49,51", 3)
End Sub

 

[GKIL67]

I've just found this nice piece of code but it is for Excel and beyond my capabilities to transform it into an Access function... I tried it and it does what it promises, fast! It is strange nothing like this exists for Access VB since this kind of calculations require the depth of a database and it seems like a nice FAQ.

'----------------------------------------------------------------------------
'Following is a macro based solution form Myrna Larson (Microsoft MVP) on
'permutation and combinations

'1. It allows Combinations or Permutations (see note below).
'2. The macro handles numbers, text strings, words (e.g. names of people) or
'symbols.
'3. The combinations are written to a new sheet.
'4. Results are returned almost instantaneously.

'Setup:
'In sheet1:
'Cell A1, put “C” (Combinations) or “P” (Permutations).
'Cell A2, put the number of items in the subset – in my case it’s 3.
'Cells A3 down, your list of numbers
'----------------------------------------------------------------------------

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet

Sub ListPermutationsOrCombinations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim n As Double
Const BufferSize As Long = 4096

   Worksheets("Sheet1").Range("A1").Select
   Set Rng = Selection.Columns(1).Cells
   If Rng.Cells.Count = 1 Then
       Set Rng = Range(Rng, Rng.End(xlDown))
   End If
   
   PopSize = Rng.Cells.Count - 2
   If PopSize < 2 Then GoTo DataError
   
   SetSize = Rng.Cells(2).Value
   If SetSize > PopSize Then GoTo DataError
   
   Which = UCase$(Rng.Cells(1).Value)
   Select Case Which
       Case "C"
           n = Application.WorksheetFunction.Combin(PopSize, SetSize)
       Case "P"
           n = Application.WorksheetFunction.Permut(PopSize, SetSize)
       Case Else
           GoTo DataError
   End Select
   If n > Cells.Count Then GoTo DataError
   
   Application.ScreenUpdating = False
   
   Set Results = Worksheets.Add
   
   vAllItems = Rng.Offset(2, 0).Resize(PopSize).Value
   ReDim Buffer(1 To BufferSize) As String
   BufferPtr = 0
   
   If Which = "C" Then
       AddCombination PopSize, SetSize
   Else
       AddPermutation PopSize, SetSize
   End If
   vAllItems = 0
   
   Application.ScreenUpdating = True
   Exit Sub
   
DataError:
   If n = 0 Then
       Which = "Enter your data in a vertical range of at least 4 cells." _
       & String$(2, 10) _
       & "Top cell must contain the letter C or P, 2nd cell is the Number" _
       & "of items in a subset, the cells below are the values from Which" _
       & "the subset is to be chosen."
   
   Else
       Which = "This requires " & Format$(n, "#,##0") & _
       " cells, more than are available on the worksheet!"
   End If
   MsgBox Which, vbOKOnly, "DATA ERROR"
Exit Sub
End Sub

Private Sub AddPermutation(Optional PopSize As Integer = 0, _
                          Optional SetSize As Integer = 0, _
                          Optional NextMember As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Static Used() As Integer
Dim i As Integer

   If PopSize <> 0 Then
       iPopSize = PopSize
       iSetSize = SetSize
       ReDim SetMembers(1 To iSetSize) As Integer
       ReDim Used(1 To iPopSize) As Integer
       NextMember = 1
   End If
   
   For i = 1 To iPopSize
       If Used(i) = 0 Then
           SetMembers(NextMember) = i
           If NextMember <> iSetSize Then
               Used(i) = True
               AddPermutation , , NextMember + 1
               Used(i) = False
           Else
               SavePermutation SetMembers()
           End If
       End If
   Next i
   
   If NextMember = 1 Then
       SavePermutation SetMembers(), True
       Erase SetMembers
       Erase Used
   End If

End Sub 'AddPermutation

Private Sub AddCombination(Optional PopSize As Integer = 0, _
                          Optional SetSize As Integer = 0, _
                          Optional NextMember As Integer = 0, _
                          Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer
   
   If PopSize <> 0 Then
       iPopSize = PopSize
       iSetSize = SetSize
       ReDim SetMembers(1 To iSetSize) As Integer
       NextMember = 1
       NextItem = 1
   End If
   
   For i = NextItem To iPopSize
       SetMembers(NextMember) = i
       If NextMember <> iSetSize Then
           AddCombination , , NextMember + 1, i + 1
       Else
           SavePermutation SetMembers()
       End If
   Next i
   
   If NextMember = 1 Then
       SavePermutation SetMembers(), True
       Erase SetMembers
   End If

End Sub 'AddCombination

Private Sub SavePermutation(ItemsChosen() As Integer, _
                           Optional FlushBuffer As Boolean = False)
Dim i As Long, sValue As String
Static RowNum As Long, ColNum As Long
   
   If RowNum = 0 Then RowNum = 1
   If ColNum = 0 Then ColNum = 1
   
   If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
       If BufferPtr > 0 Then
           If (RowNum + BufferPtr - 1) > Rows.Count Then
               RowNum = 1
               ColNum = ColNum + 1
               If ColNum > 256 Then Exit Sub
           End If
       
       Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
           = Application.WorksheetFunction.Transpose(Buffer())
       RowNum = RowNum + BufferPtr
       End If
       
       BufferPtr = 0
       If FlushBuffer = True Then
           Erase Buffer
           RowNum = 0
           ColNum = 0
           Exit Sub
       Else
           ReDim Buffer(1 To UBound(Buffer))
       End If
   
   End If
   
   'construct the next set
   For i = 1 To UBound(ItemsChosen)
       sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
   Next i
   
   'and save it in the buffer
   BufferPtr = BufferPtr + 1
   Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation

 

[GKIL67]

Dear Duane,
Could you kindly clarify the exact purpose of the tblN? Is it possible to eliminate it and use instead something like a For-Next loop? How is the max value N determined?

Thank you!

 

[dhookom]

TblN is just a table that allows selecting the list of comma delimited numbers as a criteria so it returns a record for each of the numbers.

The query with numbers limited to your list is used to create a make table query of the results.

Duane
Hook'D on Access
MS Access MVP

 

[GKIL67]

I followed thru and issue is closed from my side.
Thank you! for everything.