Generating all possible combinations per macro

Good time of day, Kai!

I've tryed to solve this task and came to conclusion, that it may be possible to provide a 2-dimentional array, where number of columns shows Shelf-space and number of rows represents number of combinations. And I've stopped when I faced the task to count number of needed rows. So now your formula may let us step further. I'll try to organize circle for combinations later.

It also will be very helpful if you will attach a file with your nonflexible example.

Hi, this is the example for N=5 products.
You see that I built in 5 of the loops, according to N = 5. This needs to become flexible. Shelf-space is S=10 (can already be flexibly set - so this at least is working).

I am sure the code is not efficient at all :-)

I shortened the code, so may be that this is not fully working if you copy it - but it should.
Also, I simplified the evaluation formula, which is resultF(ip) = F(ip)+1 in the below.

Thank you!

Best regards
Kai

Sub G_combinations()

Dim shelf As Integer
Dim used As Double
Dim result As Double
Dim noproducts As Integer
Dim ip As Integer
Dim profit As Double
Dim result As Double
Dim resultF() As Variant    
Dim i As Integer
Dim F() As Variant
Dim best_F() As Variant


noproducts = 5
shelf = 10


F(1) = -1
F(2) = -1
F(3) = -1
F(4) = -1
F(5) = -1
used = 0
profit = -100000


Do While used < shelf
F(1) = F(1) + 1
used = Application.Max(0, F(1)) + Application.Max(0, F(2)) + Application.Max(0, F(3)) + Application.Max(0, F(4)) + Application.Max(0, F(5))

If used = shelf Then

For ip = 1 To noproducts



resultF(ip) = F(ip)+ 1

Next ip

result = resultF(1) + resultF(2) + resultF(3) + resultF(4) + resultF(5)

If result > profit Then
profit = result
best_F(1) = Application.Max(F(1), 0)
best_F(2) = Application.Max(F(2), 0)
best_F(3) = Application.Max(F(3), 0)
best_F(4) = Application.Max(F(4), 0)
best_F(5) = Application.Max(F(5), 0)

Else
profit = profit
End If


used = 0
Exit Do
End If



Do While used < shelf
F(2) = F(2) + 1
used = Application.Max(0, F(1)) + Application.Max(0, F(2)) + Application.Max(0, F(3)) + Application.Max(0, F(4)) + Application.Max(0, F(5))

If used = shelf Then


For ip = 1 To noproducts

resultF(ip) = F(ip)+ 1

Next ip

result = resultF(1) + resultF(2) + resultF(3) + resultF(4) + resultF(5)

If result > profit Then
profit = result
best_F(1) = Application.Max(F(1), 0)
best_F(2) = Application.Max(F(2), 0)
best_F(3) = Application.Max(F(3), 0)
best_F(4) = Application.Max(F(4), 0)
best_F(5) = Application.Max(F(5), 0)

Else
profit = profit
End If

F(2) = -1
used = 0
Exit Do
End If



Do While used < shelf
F(3) = F(3) + 1
used = Application.Max(0, F(1)) + Application.Max(0, F(2)) + Application.Max(0, F(3)) + Application.Max(0, F(4)) + Application.Max(0, F(5))


For ip = 1 To noproducts

resultF(ip) = F(ip)+ 1

Next ip

result = resultF(1) + resultF(2) + resultF(3) + resultF(4) + resultF(5)

If result > profit Then
profit = result
best_F(1) = Application.Max(F(1), 0)
best_F(2) = Application.Max(F(2), 0)
best_F(3) = Application.Max(F(3), 0)
best_F(4) = Application.Max(F(4), 0)
best_F(5) = Application.Max(F(5), 0)

Else
profit = profit
End If


If used = shelf Then
F(3) = -1
used = 0
Exit Do
End If

Do While used < shelf
F(4) = F(4) + 1
used = Application.Max(0, F(1)) + Application.Max(0, F(2)) + Application.Max(0, F(3)) + Application.Max(0, F(4)) + Application.Max(0, F(5))



For ip = 1 To noproducts

resultF(ip) = F(ip)+ 1

Next ip

result = resultF(1) + resultF(2) + resultF(3) + resultF(4) + resultF(5)

If result > profit Then
profit = result
best_F(1) = Application.Max(F(1), 0)
best_F(2) = Application.Max(F(2), 0)
best_F(3) = Application.Max(F(3), 0)
best_F(4) = Application.Max(F(4), 0)
best_F(5) = Application.Max(F(5), 0)

Else
profit = profit
End If



If used = shelf Then
F(4) = -1
used = 0
Exit Do
End If


Do While used < shelf
F(5) = F(5) + 1
used = Application.Max(0, F(1)) + Application.Max(0, F(2)) + Application.Max(0, F(3)) + Application.Max(0, F(4)) + Application.Max(0, F(5))


For ip = 1 To noproducts
resultF(ip) = F(ip)+ 1
Next ip

result = resultF(1) + resultF(2) + resultF(3) + resultF(4) + resultF(5)

If result > profit Then
profit = result
best_F(1) = Application.Max(F(1), 0)
best_F(2) = Application.Max(F(2), 0)
best_F(3) = Application.Max(F(3), 0)
best_F(4) = Application.Max(F(4), 0)
best_F(5) = Application.Max(F(5), 0)

Else
profit = profit
End If

If used = shelf Then
F(5) = -1
used = 0
Exit Do
End If
Loop

Loop
Loop
Loop
Loop



End Sub

You say order doesn't matter, yet you list 0,0,3, 0,3,0, and 3,0,0 ...?

How large could N and S be?

Generating the partitions of N for small numbers is easy enough, but calculating distinct permutations with repeated digits would be fussy.

So -- list all possible ways to put 15 items in 50 slots? I think that's =COMBIN(15+50-1, 15) ~ 160 trillion arrangements. It would take a lifetime to generate them all, which would be good, because your descendants would need the time to round up all the disk drives they could find to store the file.

As they say on Shark Tank, I'm out.

OK, I relent. Here's 4 items arranged in 5 bins:

	A	B	C	D	E
1	1	2	3	4	5
2	4
3	3	1
4	3		1
5	3			1
6	3				1
7	2	2
8	2	1	1
9	2	1		1
10	2	1			1
11	2		2
12	2		1	1
13	2		1		1
14	2			2
15	2			1	1
16	2				2
17	1	3
18	1	2	1
19	1	2		1
20	1	2			1
21	1	1	2
22	1	1	1	1
23	1	1	1		1
24	1	1		2
25	1	1		1	1
26	1	1			2
27	1		3
28	1		2	1
29	1		2		1
30	1		1	2
31	1		1	1	1
32	1		1		2
33	1			3
34	1			2	1
35	1			1	2
36	1				3
37		4
38		3	1
39		3		1
40		3			1
41		2	2
42		2	1	1
43		2	1		1
44		2		2
45		2		1	1
46		2			2
47		1	3
48		1	2	1
49		1	2		1
50		1	1	2
51		1	1	1	1
52		1	1		2
53		1		3
54		1		2	1
55		1		1	2
56		1			3
57			4
58			3	1
59			3		1
60			2	2
61			2	1	1
62			2		2
63			1	3
64			1	2	1
65			1	1	2
66			1		3
67				4
68				3	1
69				2	2
70				1	3
71					4

Sub Main()
    Const nProd     As Long = 4 ' change as desired
    Const nShlf     As Long = 5 ' change as desired

    KaNi nShlf - 1, nProd + nShlf - 1
    ActiveSheet.UsedRange
End Sub

Sub KaNi(m As Long, n As Long)
    Dim aiC()       As Long    ' Combinations (used as divider placements to partition bins)
    Dim aiO()       As Long    ' Output (counts of items between dividers)
    Dim i           As Long    ' scratch index
    Dim iRow        As Long    ' output row

    ReDim aiC(1 To m)
    ReDim aiO(1 To m + 1)

    ActiveSheet.Rows.ClearContents

    ' header
    For i = 1 To m + 1
        aiO(i) = i
    Next i
    Rows(1).Resize(, m + 1).Value = aiO

    iRow = 1

    aiC(1) = -1
    With WorksheetFunction
        Do While bNextCombo(aiC, n)

            aiO(1) = n - aiC(1) - 1
            For i = 2 To m
                aiO(i) = aiC(i - 1) - aiC(i) - 1
            Next i
            aiO(m + 1) = aiC(m)

            iRow = iRow + 1
            Rows(iRow).Resize(, m + 1).Value = aiO
        Loop
    End With
End Sub

Public Function bNextCombo(aiC() As Long, n As Long) As Boolean
    ' shg 2009-12
    '     2011-07 (modified to require aiC(0) < 0 to initialize)

    ' VBA only

    ' Sets aiC to the next combination of n choose m in lexical order
    ' Returns True unless the combination is the last, in which case
    ' it leaves aiC unmodified.

    ' If aiC(1) < 0, initializes aiC to the first combo:
    '                   {m-1,  m-2, ...,     1,   0}
    ' The last combo is {n-1,  n-2, ..., n-m+1, n-m}

    Dim m           As Long
    Dim i           As Long

    m = UBound(aiC)
    If n < m Then Exit Function

    If aiC(1) < 0 Then    ' set initial combo
        i = 1
        aiC(1) = m - 2

    Else

        ' find rightmost incrementable index
        For i = m To 2 Step -1
            If aiC(i) < aiC(i - 1) - 1 Then Exit For
        Next i
    End If

    If i <> 1 Or aiC(1) < n - 1 Then
        ' increment that index, and set 'righter' indices descending to 0
        aiC(i) = aiC(i) + 1
        For i = i + 1 To m
            aiC(i) = m - i
        Next i

        bNextCombo = True
    End If
End Function

Hi Shg and Rioran,

thanks for helping me with that.

The question is solved - I am using your code Shg. Special thanks to you.

That was immensely helpful!



Cheers
Kai

Four items across three bins is 15; three items across four is 20.

	A	B	C
1	1	2	3
2	4
3	3	1
4	3		1
5	2	2
6	2	1	1
7	2		2
8	1	3
9	1	2	1
10	1	1	2
11	1		3
12		4
13		3	1
14		2	2
15		1	3
16			4

	A	B	C	D
1	1	2	3	4
2	3
3	2	1
4	2		1
5	2			1
6	1	2
7	1	1	1
8	1	1		1
9	1		2
10	1		1	1
11	1			2
12		3
13		2	1
14		2		1
15		1	2
16		1	1	1
17		1		2
18			3
19			2	1
20			1	2
21				3

Kai, hello.

Sorry for silence, I am studying statistics more closely this days to try your task. I'm still following topic and if I will have anything significant - I will share it immidiatly.

Thanks Riorian.

Shg, I am confused. According to (N+S-1)!/(S!*(N-1)!) - which I am pretty sure about - N=4 items and S=3 spaces yields 20 combinations. And N=3 and S=4 yields 15.

How do I read the first table of your last post?

Columns A/B/C is bins?
Rows is combinations. How do I read the 3rd row then: 4 _ _. I assume this means you assign product 4 to bin A ? But with which quantity and what about the other bins, are they empty?

Perhaps I am confusing things, sorry.

Asssumption is always to fill all bins.

The first row says put 4 items in the first bin and leave the other two empty.

The next line says 3 in the first bin, 1 in the second, last one empty

... and so forth.

Hey Shg,

got it. I think we are talking different things. For me it it is important WHICH items are on the shelf - so I need to differentiate between items 1-4. I do not care where I put them onto the shelf, just whether I put them and how much of each ...

Does that make sense?

Still - I am playing with your code. I think it serves as a very good base for what I want to do. I am just not good enough in VBA to easily adapt it....


Also: 1 bin can only contain 1 product in my case. S=3 means I have 3 spaces/bins. I can accordingly put a total of 3 products. The only questions is which. I can put 3x product 1 or only 2x product 1 and 1x product 2 or .... and so forth.

Then you can reverse my definition of bins and items and get exactly the same result as yours.

Sub Main()
    Const nShlf     As Long = 3    ' change as desired
    Const nProd     As Long = 4    ' change as desired

    FillBins nProd - 1, nShlf + nProd - 1
    ActiveSheet.UsedRange
End Sub

You're welcome.