Algorithm that performs the combination of elements of a vector in VBA?

Question

I need to take a vector in vba with any N elements and perform the combination of such elements. The idea is to have a function that takes 2 arguments. The vector with the elements to be combined and the type of combination. 3x3, 4x4, etc.

If this idea is too complicated, because I think it should be used recursion could be an algorithm that performs this task by iteration. In this case 3x3 combined elements.

The vector that was the return of the function will possess the grouped elements and when picking up the grouped elements I will have the desired combination.

Ex: This vector will be inserted into the function, but can be with as many elements as desired. This is just an example.

Array_Items(1)=1
Array_Items(2)=2
Array_Items(3)=3
Array_Items(4)=4

Result of the combination 3x3 in this vector below. If I take this vector of 3 in 3 elements each iteration gives me a combination. That is, the first combination is 1,2,3; the second 1,2,4; the third 1,3,4, etc. until the end. The function must work for any vector size that enters to generate the output 3 to 3. (Of course without breaking the vba limit, but that’s another story). For combination no matter the order. They are unique. The vector that will enter as argument of the function will never have repeated elements. It will have data consistency before.

Comb_array(1)=1
Comb_array(2)=2
Comb_array(3)=3
Comb_array(4)=1
Comb_array(5)=2
Comb_array(6)=4
Comb_array(7)=1
Comb_array(8)=3
Comb_array(9)=4
Comb_array(10)=2
Comb_array(11)=3
Comb_array(12)=4

vba

I imagine two ties inside each other, but I tried to write in a hundred ways and nothing.

Date: 15/09/2019 Function that performs all 3x3 vector items combinators Not implemented

Public Function aMake_Comb_x3(Array_Items() As String) As String()


    Dim Index1 As Integer
    Dim Index2 As Integer
    Dim index3 As Integer
    Dim Index4 As Integer
    Dim Comb_Array() As Integer
    Dim Array_Aux1() As Integer
    Dim Cont As Integer
    Dim Comb_Type As Integer
    Dim X As Integer

    Comb_Type = 3
    Index1 = 1
    Index2 = 2
    index3 = 3
    Index4 = 1

    X = 2

    'Redimensiona o vetor para a qtd. max. de combinacoes.
    'A posicao 0 sera Ignorada, para facilitar os calculos e loops no preenchimento
    ReDim Comb_Array((( WorksheetFunction. combin(UBound(Array_Items) + 1, Comb_Type)) * Comb_Type))

    'Redimensiona os vetores para ignorar a posicao "0"
    ReDim Array_Aux1(UBound(Array_Items) + 1)

    'Preenche o vetor auxiliar
    For Cont = 1 To UBound(Array_Items) + 1


        Array_Aux1(Cont) = Array_Items(Cont - 1)


    Next Cont


    For Index4 = 1 To UBound(Comb_Array)


        Comb_Array(Index4) = Array_Aux1(Index1)
        Index4 = Index4 + 1

        For Index2 = X To UBound(Array_Aux1)

            Comb_Array(Index4) = Array_Aux1(Index2)


            If Index2 Mod Comb_Type = 0 Then

                Index2 = X
                Exit For

            End If

            Index4 = Index4 + 1


            'If Index4 Mod Comb_Type = 0 Then

                'Index2 = Index2 * 2

            'End If

        Next Index2



    Next Index4



End Function

If anyone has an idea or link with such an algorithm would be grateful. I spent a lot of time trying and nothing.

Thanks for your help.

Answer 1

'At the beginning of the module I put The variables C and Combs_n as private. Now would just call Comb_elements() anywhere in the program passing the arguments I got the result.

Private Combs_n As Variant
Private c As Integer


Function comb_elementos(arr() As String, p As Long) As Variant

Dim comb As Long, n As Long
Dim result As Variant

c = 0

n = UBound(arr) - LBound(arr) + 1
comb = WorksheetFunction.Combin(n, p)

ReDim Combs_n(0 To comb - 1, 0 To p - 1)

comb_elementos = combinacao(arr, p)

'comb_elementos = Combs_n

End Function


'Utiliza Variaveis Private
'Funcionamento: Ok
Private Function combinacao(arr() As String, r As Long, Optional i As Long, Optional l As Long) As Variant


Dim x As Long, y As Long, n As Long


n = UBound(arr) - LBound(arr) + 1

If n < 1 Or r > n Or r < 0 Then Err.Raise 1
If i < 1 Then i = 1
If l < 1 Then l = 1
If c < 1 Then c = 1
If r = 0 Then
    Combs_n(0, 0) = 1
    Exit Function
End If

For x = i To n - r + 1
    If r = 1 Then
        If c > 1 Then
            For y = 0 To l - 2
                If Combs_n(c - 1, y) = "" Then Combs_n(c - 1, y) = Combs_n(c - 2, y)
            Next
        End If
        Combs_n(c - 1, l - 1) = arr(x - 1)
        c = c + 1
    Else
        Combs_n(c - 1, l - 1) = arr(x - 1)
        combinacao arr, r - 1, x + 1, l + 1
    End If
Next

combinacao = Combs_n

End Function

Answer 2

In the code below, the input was an array arr = Array(5, 4, 3, 2, 1) and 3x3, that is to say, p = 3.

Then the function comb_elementos is called with the array and the amount of elements as parameters: comb_elementos(arr, p)

And the results are given in a name matrix result_matrix.

Code

Option Explicit
Private c As Long

Sub teste()
    Dim arr() As Variant
    Dim p As Long, i As Long, k As Long
    Dim result As String
    Dim result_matrix As Variant

    arr = Array(5, 4, 3, 2, 1)
'   ReDim arr(1 To 5)
'    arr(1) = 1
'    arr(2) = 2
'    arr(3) = 3
'    arr(4) = 4
'    arr(5) = 5
    p = 3

    result_matrix = comb_elementos(arr, p)

    'Verificar Resultado
    For i = LBound(result_matrix) To UBound(result_matrix)
        result = ""
        For k = 0 To p - 1
            result = result & " " & result_matrix(i, k)
        Next k
        Debug.Print Trim(result)
    Next i
End Sub

Function comb_elementos(arr() As Variant, p As Long)
    Dim combs_n As Variant
    Dim comb As Long, n As Long
    Dim result As Variant

    n = UBound(arr) - LBound(arr) + 1
    comb = WorksheetFunction.Combin(n, p)

    c = 0
    ReDim combs_n(0 To comb - 1, 0 To p - 1)

    combinacao combs_n, arr, p

    comb_elementos = combs_n
End Function

Private Function combinacao(combs_n As Variant, arr() As Variant, r As Long, Optional i As Long, Optional l As Long) As Long
    Dim x As Long, y As Long, n As Long

    If i <= LBound(arr) Then i = LBound(arr)
    If l < 1 Then l = 1
    If c < 1 Then c = 1
    If r = 0 Then
        combs_n(0, 0) = 1
        Exit Function
    End If

    For x = i To UBound(arr) - r + 1
        If r = 1 Then
            If c > 1 Then
                For y = 0 To l - 2
                    If combs_n(c - 1, y) = "" Then combs_n(c - 1, y) = combs_n(c - 2, y)
                Next
            End If
            combs_n(c - 1, l - 1) = arr(x)
            c = c + 1
        Else
            combs_n(c - 1, l - 1) = arr(x)
            combinacao combs_n, arr, r - 1, x + 1, l + 1
        End If
    Next
End Function

Upshot

The result can be checked in the code where it is commented 'Verificar Resultado, in which the Debug.Print prints in the immediate verification window:

Or by checking the variable combs_n in the variable window: