[Visual Basic] - Combinazioni con ripetizione

[lucausa75]

Salve ragazzi,
vorrei realizzare una programma scritto in Visual Basic che mi elabora tutte le combinazioni possibili di N numeri a gruppi di K.
Ad esempio se ho queste 4 lettere: a,b,c,d il mio programma deve essere in grado di elaborare tutte le seguenti possibili 20 combinazioni non ordinate:


a b c-a b d-a c d-b c d
a a a-b b a-c c a-d d a
a a b-b b b-c c b-d d b
a a c-b b c-c c c-d d c
a a d-b b c-c c d-d d d

Mi aiutate?

Grazie

[MarcoGG]

Combinazioni con ripetizione su N elementi di classe K.
Io l'ho risolto così :

    Public Function CombinazioniConRipetizione(ByVal arrayElementi() As String, ByVal classe As Byte) As List(Of String)

        Dim LC As New List(Of String)
        If arrayElementi.Count = 0 Then Return LC
        If classe = 0 Then Return LC

        Dim aP(classe - 1) As Integer
        Dim C As String = ""
        Do
            C = ""
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next
            LC.Add(C)

            Dim cnt As Integer = 0
            For i As Integer = aP.Count - 1 To 0 Step -1
                If aP(i) = arrayElementi.Count - 1 Then
                    cnt += 1
                    If cnt = aP.Count Then Exit Do
                Else
                    aP(i) += 1
                    For j = 0 To aP.Count - 1
                        If i < j Then aP(j) = aP(i)
                    Next
                    Exit For
                End If
            Next
        Loop

        Return LC

    End Function

[lucausa75]

Originariamente inviato da MarcoGG

Combinazioni con ripetizione su N elementi di classe K.
Io l'ho risolto così :

    Public Function CombinazioniConRipetizione(ByVal arrayElementi() As String, ByVal classe As Byte) As List(Of String)

        Dim LC As New List(Of String)
        If arrayElementi.Count = 0 Then Return LC
        If classe = 0 Then Return LC

        Dim aP(classe - 1) As Integer
        Dim C As String = ""
        Do
            C = ""
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next
            LC.Add(C)

            Dim cnt As Integer = 0
            For i As Integer = aP.Count - 1 To 0 Step -1
                If aP(i) = arrayElementi.Count - 1 Then
                    cnt += 1
                    If cnt = aP.Count Then Exit Do
                Else
                    aP(i) += 1
                    For j = 0 To aP.Count - 1
                        If i < j Then aP(j) = aP(i)
                    Next
                    Exit For
                End If
            Next
        Loop

        Return LC

    End Function

Ciao e grazie 1000 per il codice

Quando lo inserisco in Visual Basic mi da degli errori, indicati in rosso, come indicato nella figura.
Non riesco a capire se ilcodice contiene delle parti da te commentate:



Probabilmente l'errore è dovuto al fatto che sto utilizzando VBA e non VB...

Ti dispiacerebbe mandarmi il file vbp completo?

[MarcoGG]

Il mio è codice VB 2008, quindi .NET. Devi fare le opportune modifiche, prima fra tutte la sostituzione della List() con un array ( utilizzando ReDim Preserve sullo stesso ad ogni inserimento di una nuova combinazione C ). Inoltre le dichiarazioni sulla stessa linea vanno "spezzate", perchè VBA non le supporta...
Se ho tempo più tardi vedo di postare anche una soluzione VBA, intanto vedi se ce la fai a tradurre...

[lucausa75]

Originariamente inviato da MarcoGG

Il mio è codice VB 2008, quindi .NET. Devi fare le opportune modifiche, prima fra tutte la sostituzione della List() con un array ( utilizzando ReDim Preserve sullo stesso ad ogni inserimento di una nuova combinazione C ). Inoltre le dichiarazioni sulla stessa linea vanno "spezzate", perchè VBA non le supporta...
Se ho tempo più tardi vedo di postare anche una soluzione VBA, intanto vedi se ce la fai a tradurre...

...e per le combinazioni SENZA ripetizione ?

[lucausa75]

Originariamente inviato da MarcoGG

Il mio è codice VB 2008, quindi .NET. Devi fare le opportune modifiche, prima fra tutte la sostituzione della List() con un array ( utilizzando ReDim Preserve sullo stesso ad ogni inserimento di una nuova combinazione C ). Inoltre le dichiarazioni sulla stessa linea vanno "spezzate", perchè VBA non le supporta...
Se ho tempo più tardi vedo di postare anche una soluzione VBA, intanto vedi se ce la fai a tradurre...

Tradotto il codice ma sottoforma di una Sub e successivamente provato con esito positivo:

Sub CombinazioniConRipetizione(n As Long, k As Long)

    Dim aP() As Long
    Dim C As String
    Dim cnt As Long
    Dim arrayElementi() As Long
    
    ReDim aP(k) As Long
    ReDim arrayElementi(n) As Long
    
    lstCombinazioni.Clear
    
    Do
        C = ""
        For i = 0 To UBound(aP) - 1
            C = C & CStr(aP(i))
        Next
        
        lstCombinazioni.AddItem C

        cnt = 0
        For i = UBound(aP) - 1 To 0 Step -1
            If aP(i) = UBound(arrayElementi) - 1 Then
                cnt = cnt + 1
                If cnt = UBound(aP) Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP) - 1
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next
    Loop

    lblContatore = lstCombinazioni.ListCount

End Sub

[MarcoGG]

Ok. Posto anche la mia versione VBA della CombinazioniConRipetizione, sotto forma di Function, valida per ogni utilizzo. Il tipo restituito è una Collection, che è abbastanza "simile" ( parola grossa ) alla List() di VB.NET... :

Public Function CombinazioniConRipetizione(arrayElementi() As Variant, classe As Byte) As Collection

    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniConRipetizione = LC
    End If
    If classe = 0 Then
        Set CombinazioniConRipetizione = LC
    End If

    Dim aP() As Integer
    ReDim aP(classe - 1)
    Dim i As Integer
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
        
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next i
    Loop
    
    Set CombinazioniConRipetizione = LC
    
End Function

[lucausa75]

Originariamente inviato da MarcoGG

Ok. Posto anche la mia versione VBA della CombinazioniConRipetizione, sotto forma di Function, valida per ogni utilizzo. Il tipo restituito è una Collection, che è abbastanza "simile" ( parola grossa ) alla List() di VB.NET... :

Public Function CombinazioniConRipetizione(arrayElementi() As Variant, classe As Byte) As Collection

    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniConRipetizione = LC
    End If
    If classe = 0 Then
        Set CombinazioniConRipetizione = LC
    End If

    Dim aP() As Integer
    ReDim aP(classe - 1)
    Dim i As Integer
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
        
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next i
    Loop
    
    Set CombinazioniConRipetizione = LC
    
End Function

Ottimo
Ma se volessimo parlare di Combinazioni SENZA Ripetizione ?
Avete una Function o una Sub già pronta?

Grazie 1000!

[MarcoGG]

Originariamente inviato da lucausa75

Ottimo
Ma se volessimo parlare di Combinazioni SENZA Ripetizione ?
Avete una Function o una Sub già pronta?

Grazie 1000!

Pronta !
Basta aggiustare qualcosa :
- Mentre nelle combinazioni con ripetizione la classe può anche superare il numero di elementi dell'insieme N, nelle combinazioni semplici no.
- L'array delle posizioni aP() va inizializzato alla prima posizione valida ( non devono essere tutti zero ).
- Quando nel ciclo For interno un elemento di aP() viene incrementato di 1, quelli di indice maggiore vanno aggiornati diversamente.

Per il resto è molto simile alla precedente ( sempre per VB 2008 - a te il piacere di tradurre... ) :

    Public Function CombinazioniSemplici(ByVal arrayElementi() As String, ByVal dimensioneGruppo As Byte) As List(Of String)

        Dim LC As New List(Of String)
        If arrayElementi.Count = 0 Then Return LC
        If dimensioneGruppo = 0 Or dimensioneGruppo > arrayElementi.Count Then Return LC

        Dim aP(dimensioneGruppo - 1) As Integer
        For i As Integer = 0 To aP.Count - 1
            aP(i) = i
        Next

        Dim C As String = ""
        Do
            C = ""
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next
            LC.Add(C)

            Dim cnt As Integer = 0
            For i As Integer = aP.Count - 1 To 0 Step -1
                If aP(i) = arrayElementi.Count - 1 - cnt Then
                    cnt += 1
                    If cnt = aP.Count Then Exit Do
                Else
                    aP(i) += 1
                    For j = 0 To aP.Count - 1
                        If i < j Then aP(j) = aP(i) + (j - i)
                    Next
                    Exit For
                End If
            Next
        Loop

        Return LC

    End Function

[lucausa75]

Originariamente inviato da MarcoGG

Pronta !
Basta aggiustare qualcosa :
- Mentre nelle combinazioni con ripetizione la classe può anche superare il numero di elementi dell'insieme N, nelle combinazioni semplici no.
- L'array delle posizioni aP() va inizializzato alla prima posizione valida ( non devono essere tutti zero ).
- Quando nel ciclo For interno un elemento di aP() viene incrementato di 1, quelli di indice maggiore vanno aggiornati diversamente.

Per il resto è molto simile alla precedente ( sempre per VB 2008 - a te il piacere di tradurre... ) :

    Public Function CombinazioniSemplici(ByVal arrayElementi() As String, ByVal dimensioneGruppo As Byte) As List(Of String)

        Dim LC As New List(Of String)
        If arrayElementi.Count = 0 Then Return LC
        If dimensioneGruppo = 0 Or dimensioneGruppo > arrayElementi.Count Then Return LC

        Dim aP(dimensioneGruppo - 1) As Integer
        For i As Integer = 0 To aP.Count - 1
            aP(i) = i
        Next

        Dim C As String = ""
        Do
            C = ""
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next
            LC.Add(C)

            Dim cnt As Integer = 0
            For i As Integer = aP.Count - 1 To 0 Step -1
                If aP(i) = arrayElementi.Count - 1 - cnt Then
                    cnt += 1
                    If cnt = aP.Count Then Exit Do
                Else
                    aP(i) += 1
                    For j = 0 To aP.Count - 1
                        If i < j Then aP(j) = aP(i) + (j - i)
                    Next
                    Exit For
                End If
            Next
        Loop

        Return LC

    End Function

Grazie 1000 per il codice che ho tradotto correggendoti, probabilmente, un errore in entrambe le funzioni:

NO
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next

SI
            For i As Integer = 0 To aP.Count - 1
                C = C & aP(i)
            Next

Verifica e fammi sapere
Cmq così come ho tradotto le due routine funziona:

Sub CombinazioniConRipetizione(n As Long, k As Long)
    
    Dim i As Long
    Dim j As Long
    Dim aP() As Long
    Dim C As String
    Dim cnt As Long
    Dim arrayElementi() As Long
    
    ReDim aP(k) As Long
    ReDim arrayElementi(n) As Long
    
    lstCombinazioni.Clear
    
    Do
        C = ""
        For i = 0 To UBound(aP) - 1
            C = C & CStr(aP(i))
        Next
        
        lstCombinazioni.AddItem C

        cnt = 0
        For i = UBound(aP) - 1 To 0 Step -1
            If aP(i) = UBound(arrayElementi) - 1 Then
                cnt = cnt + 1
                If cnt = UBound(aP) Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP) - 1
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next
    Loop

    lblContatore = lstCombinazioni.ListCount

End Sub

Sub CombinazioniOrdinate(n As Long, k As Long)

    Dim i As Long
    Dim j As Long
    Dim aP() As Long
    Dim C As String
    Dim cnt As Long
    Dim arrayElementi() As Long
    
    ReDim aP(k) As Long
    ReDim arrayElementi(n) As Long
    
    lstCombinazioni.Clear

    For i = 0 To UBound(aP) - 1
        aP(i) = i
    Next

    C = ""
    Do
        C = ""
        For i = 0 To UBound(aP) - 1
            C = C & CStr(aP(i))
        Next
        
        lstCombinazioni.AddItem C

        cnt = 0
        For i = UBound(aP) - 1 To 0 Step -1
            If aP(i) = UBound(arrayElementi) - 1 - cnt Then
                cnt = cnt + 1
                If cnt = UBound(aP) Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP) - 1
                    If i < j Then aP(j) = aP(i) + (j - i)
                Next
                Exit For
            End If
        Next
    Loop

    lblContatore = lstCombinazioni.ListCount

    End Sub

[MarcoGG]

Non c'è alcun errore nelle mie Function. Appena ho un po' di tempo posto una soluzione completa di esempi di utilizzo...

[lucausa75]

Originariamente inviato da MarcoGG

Non c'è alcun errore nelle mie Function. Appena ho un po' di tempo posto una soluzione completa di esempi di utilizzo...

...non mi permetterei mai di affermare che c'è un errore nelle tue funzioni è solo che trovo strano che apportando le correzioni da me suggerite mi funziona...cmq!

Hai dato un'occhiata al mio codice in Visual Basic 6?

Prova a far girare il codice prendendo come esempio questa pagina: http://www.ripmat.it/mate/l/lb/lbcb.html

Grazie ancora!

[MarcoGG]

Originariamente inviato da lucausa75

NO
            For i As Integer = 0 To aP.Count - 1
                C = C & arrayElementi(aP(i))
            Next

SI
            For i As Integer = 0 To aP.Count - 1
                C = C & aP(i)
            Next

Verifica e fammi sapere

Ok. Allora :

- Solitamente una Sub è meno generica e meno riutilizzabile di una Function, perciò non ho testato le tue Sub. Immagino che tu le abbia modificate per un motivo valido nel tuo caso.
Nel mio caso ( con le Function ) l'array aP() è l'array delle posizioni, e NON va confuso con arrayElementi, che invece va passato in input alle Function e contiene gli N elementi dell'insieme.
Perciò, nel mio caso :

C = C & arrayElementi(aP(i))

è l'istruzione giusta,
mentre :

C = C & aP(i)

non è corretta.

- Rimanendo in VBA, la Function corretta per le Combinazioni Semplici è la seguente :

Public Function CombinazioniSemplici(arrayElementi() As Variant, dimensioneGruppo As Byte) As Collection

    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniSemplici = LC
    End If
    If dimensioneGruppo = 0 Or dimensioneGruppo > UBound(arrayElementi) Then
        Set CombinazioniSemplici = LC
    End If

    Dim aP() As Integer
    ReDim aP(dimensioneGruppo - 1)
    Dim i As Integer
    For i = 0 To UBound(aP)
        aP(i) = i
    Next i
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
        
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) - cnt Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i) + (j - i)
                Next
                Exit For
            End If
        Next i
    Loop
    
    Set CombinazioniSemplici = LC
    
End Function

E un suo utilizzo-tipo è questo ( esempio Excel-VBA con una ListBox ) :

    ListBox1.Clear
    
    Dim N() As Variant
    N = Array("a", "b", "c", "d")
    Dim K As Byte
    K = 3
    
    Dim Comb As Collection
    Set Comb = CombinazioniSemplici(N, K)
    
    Dim i As Integer
    For i = 1 To Comb.Count
        ListBox1.AddItem (Comb(i))
    Next i
    
    MsgBox Comb.Count

- Passiamo alle Combinazioni Con Ripetizione ( VBA ) :

Public Function CombinazioniConRipetizione(arrayElementi() As Variant, classe As Byte) As Collection

    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniConRipetizione = LC
    End If
    If classe = 0 Then
        Set CombinazioniConRipetizione = LC
    End If

    Dim aP() As Integer
    ReDim aP(classe - 1)
    Dim i As Integer
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
        
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i)
                Next
                Exit For
            End If
        Next i
    Loop
    
    Set CombinazioniConRipetizione = LC
    
End Function

E un suo utilizzo-tipo :

    ListBox1.Clear
    
    Dim N() As Variant
    N = Array("a", "b", "c", "d")
    Dim K As Byte
    K = 3
    
    Dim Comb As Collection
    Set Comb = CombinazioniConRipetizione(N, K)
    
    Dim i As Integer
    For i = 1 To Comb.Count
        ListBox1.AddItem (Comb(i))
    Next i
    
    MsgBox Comb.Count

A questo punto la Function che riceve in ingresso un array Variant permette una gran flessibilità, anche in virtù del fatto che, come ho già detto, l'array delle posizioni aP() è indipendente dall'arrayElementi() .
Posso darle in pasto elementi di ogni tipo, come caratteri, stringhe, interi, decimali, currency e quant'altro :

   Dim N() As Variant

   N = Array("a", "b", "c", "d")

   N = Array("str1", "str2", "str3", "str4")

   N = Array(1, 2, 3, 4)

   N = Array(1.11, 2.22, 3.33, 4.44)

   ...
   ...

E funzionerà sempre.

Credo sia tutto molto più chiaro adesso.

[lucausa75]

MarcoGG non ho parole: sei stato grande...anzi grandissimo

MarcoGG santo subito!!!

[MarcoGG]

Originariamente inviato da lucausa75

MarcoGG non ho parole: sei stato grande...anzi grandissimo

MarcoGG santo subito!!!

[lucausa75]

....e se adesso volessi realizzare un programma che mi visualizzi tutte le 24 (4!) disposizioni che si possono ottenere con le lettere: a, b, c, d?

Grazie

[MarcoGG]

E poi ci sono le Disposizioni di K su N, con K<N con e senza ripetizione, le Permutazioni, le Dismutazioni...
Beh, forza e coraggio ! Credo di aver già fonito parecchi spunti per continuare...

[f4nt0m]

salve a tutti!!!
ho lettto tutto ,,, ee mi è venuto in mente unaa cosa..,,,
se io volessi calcolare combinazioni ... in seguente modo ,,,

a b c d e f g

voglio che "a" si ripete solo in posizione 3 , 5, 7
"b" in pos2, pos4, pos6
"c" pos1, pos2, pos3, pos4, pos5, pos6, pos7

è possibile fare una cosa del genere ????

ehemm ........ scusate per italiano nn corretto

[MarcoGG]

Originariamente inviato da f4nt0m

a b c d e f g

voglio che "a" si ripete solo in posizione 3 , 5, 7
"b" in pos2, pos4, pos6
"c" pos1, pos2, pos3, pos4, pos5, pos6, pos7

Non sono sicuro di aver capito cosa intendi, ma prova usando i miei codici, condizionando l'array delle posizioni in modo da tenere solo le posizioni desiderate...

[f4nt0m]

Originariamente inviato da MarcoGG

Non sono sicuro di aver capito cosa intendi, ma prova usando i miei codici, condizionando l'array delle posizioni in modo da tenere solo le posizioni desiderate...

va bien ,,, provo