Utilisation des permutations pour trier les vecteurs stochastiques

Question

Je dois créer une collection de vecteurs stochastiques (VBA) avec les caractéristiques suivantes : a) chaque vecteur est un tableau à 10 dimensions ; b) toutes les composantes non nulles du vecteur ont la même valeur. La collection doit avoir tous les vecteurs possibles dans ces conditions.

J'ai commencé à le faire en ajoutant des vecteurs un par un à la collection, comme ceci :

Dim DB As New Collection: Set DB = New Collection
'First set:
    DB.Add Array(1, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    DB.Add Array(0, 1, 0, 0, 0, 0, 0, 0, 0, 0)
    DB.Add Array(0, 0, 1, 0, 0, 0, 0, 0, 0, 0)
    ...
    DB.Add Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 1)
'Second set:
    DB.Add Array(1/2, 1/2, 0, 0, 0, 0, 0, 0, 0, 0)
    DB.Add Array(1/2, 0, 1/2, 0, 0, 0, 0, 0, 0, 0)
    DB.Add Array(1/2, 0, 0, 1/2, 0, 0, 0, 0, 0, 0)
    ...
    DB.Add Array(0, 0, 0, 0, 0, 0, 0, 0, 1/2, 1/2)
'Third set:
    DB.Add Array(1/3, 1/3, 1/3, 0, 0, 0, 0, 0, 0, 0)
    DB.Add Array(1/3, 1/3, 0, 1/3, 0, 0, 0, 0, 0, 0)
    ...

Et ainsi de suite jusqu'à obtenir le dernier vecteur (qui constitue l'ensemble du dixième ensemble) :

...
'Tenth set:
    DB.Add Array(1/10, 1/10, 1/10, 1/10, 1/10, 1/10, 1/10, 1/10, 1/10, 1/10)

Eh bien, comme vous le savez peut-être, la collection finira par avoir 1023 vecteurs, donc ma question est très simple (je crois que la question est la seule chose simple) : Existe-t-il un moyen de faire cela sans écrire explicitement les 1023 vecteurs ?

Laissez-moi vous montrer ce que j'ai obtenu jusqu'à présent :

Tout d'abord, je peux obtenir le résultat en obtenant les mêmes tableaux avec des 1 à la place des composants de la fraction.

Deuxièmement, je ne peux pas le faire pour la première série elle-même. Comment je peux faire quelque chose comme

For x = 0 to 9
    DB.Add Array(x, 0, 0, 0, 0, 0, 0, 0, 0, 0)
Next x

travailler pour donner le résultat que je prétends ? Veuillez noter que je sais que le dernier bout de code ne me donne pas le premier ensemble de vecteurs... C'est juste pour vous donner une idée de ce que je demande.

En ce qui concerne la troisième place, je pense qu'une fois que j'ai obtenu de l'aide pour résoudre le problème de la première série, je suis capable de faire de même pour les autres. Néanmoins, si vous êtes désireux de m'aider à faire tout le script jusqu'à la dixième série, qui suis-je pour dire non, eh eh !

Je sais que c'est un peu délicat cette fois-ci ! Toute aide sera très appréciée. Et, comme toujours, merci d'avance à tous.

Answer 1

Vous pouvez résoudre votre problème comme ceci :

• Pour chaque "ensemble", le nombre de combinaisons de tableaux est donné par la formule suivante N Choisissez K où N est égal à 10 et K est le Nième numéro de l'ensemble.

• Nous pouvons obtenir le nombre total de combinaisons en additionnant 10 Choix 1 + 10 Choix 2 + 10 Choix 3 etc. jusqu'à 10 Choix 10. Le total est de 1023, comme vous l'avez déjà observé.

• Considérez chaque tableau comme une chaîne binaire de 10 0 et 1. Vous pouvez alors boucler de 1 à 1023 et obtenir l'équivalent binaire à 10 chiffres de ce nombre décimal - qui comptera de 0000000001 à 1111111111.

• Obtenez le nombre binaire sous forme de chaîne et comptez les 1 dans la chaîne. Le nombre de 1 vous donne l'ensemble auquel le nombre appartient, par exemple, trois 1 signifie que le tableau serait dans le troisième ensemble selon votre exemple.

• Bouclez sur chaque caractère de la chaîne et pour chaque 1, ajoutez l'inverse du nombre de 1 que vous avez compté au tableau dans cet emplacement. Par exemple, s'il y a trois 1, chaque emplacement du tableau reçoit 1/3. Pour chaque 0, ajoutez 0 à cet emplacement. Cela garantit que la somme des éléments du tableau est égale à 1.

• Ajoutez le tableau à la collection, et bouclez

Exemple de code ci-dessous - J'ai commenté quelques liens vers du code utile pour cette tâche :

• N Choisissez K avec VB.NET (portage en VBA très facile)
• DecToBin pour les grands nombres (mieux que WorksheetFunction.Dec2Bin )

Code :

Option Explicit

Sub BuildStochasticArray()

    Dim coll As Collection
    Dim lngSlots As Long
    Dim lngCombinations As Long
    Dim lng1 As Long
    Dim strBin As String
    Dim lngNumberOfOnes As Long
    Dim lng2 As Long
    Dim var As Variant
    Dim dblSum As Double

    Set coll = New Collection
    ' you have 10 slots
    lngSlots = 10
    ' you have this many combinations - 1023 for 10
    lngCombinations = GetTotalCombinations(lngSlots, lngSlots)

    For lng1 = 1 To lngCombinations
        'get binary representation with 0 padding upto lngSlots
        strBin = DecToBin(lng1, lngSlots)
        'count number of 1s - this will define you fraction
        lngNumberOfOnes = Len(strBin) - Len(Replace(strBin, "1", ""))
        'create the set
        ReDim var(1 To lngSlots) As Double
        For lng2 = 1 To lngSlots
            If Mid$(strBin, lng2, 1) = "1" Then
                var(lng2) = 1 / lngNumberOfOnes
            Else
                var(lng2) = 0
            End If
        Next lng2
        'add to collection
        coll.Add var, strBin

    Next lng1

    ' test the procedure by iterating the collection and check each vector adds to 1
    For lng1 = 1 To lngCombinations
        var = coll.Item(lng1)
        ' round to 5 places because of floating point math
        dblSum = Round(Application.WorksheetFunction.Sum(var), 5)
        If dblSum <> 1 Then
            Debug.Print "Error at index " & lng1
        End If
    Next lng1

    Debug.Print "Collection items " & coll.Count

End Sub

Function GetTotalCombinations(n As Long, k As Long) As Long
    Dim i As Long
    Dim j As Long
    For i = 1 To k
        j = j + NChooseK(n, i)
    Next i
    GetTotalCombinations = j
End Function

' http://www.vb-helper.com/howto_net_calculate_n_choose_k.html
Function NChooseK(n As Long, k As Long) As Long
    Dim lngResult As Long
    Dim i As Long

    lngResult = 1
    For i = 1 To k
        lngResult = lngResult * (n - (k - i))
        lngResult = lngResult / i
    Next i

    NChooseK = lngResult

End Function

' https://stackoverflow.com/questions/22109116/using-dec2bin-with-large-numbers
Function DecToBin(ByVal lngDec, lngNumberOfBits As Long) As String
    Dim strBin As String

    strBin = ""
    Do While lngDec <> 0
        strBin = Trim$(Str$(lngDec - 2 * Int(lngDec / 2))) & strBin
        lngDec = Int(lngDec / 2)
    Loop

    strBin = Right$(String$(lngNumberOfBits, "0") & strBin, lngNumberOfBits)

    DecToBin = strBin

End Function

Answer 2

Grâce à @Robin Mackenzie j'ai réussi à trouver un moyen d'écrire un code simple pour créer la collection de tableaux que je prétendais. Voici ma façon de faire, juste pour référence future :

Dim DB As New Collection: Set DB = New Collection
Dim X01 As Integer, X02 As Integer, X03 As Integer, X04 As Integer, X05 As Integer
Dim X06 As Integer, X07 As Integer, X08 As Integer, X09 As Integer, X10 As Integer
Dim CODE As String: Dim SUM As Integer
For x = 1 To 1023
    CODE = DecToBin(x)
    X01 = Val(Mid(Format(CODE, "0000000000"), 1, 1))
    X02 = Val(Mid(Format(CODE, "0000000000"), 2, 1))
    X03 = Val(Mid(Format(CODE, "0000000000"), 3, 1))
    X04 = Val(Mid(Format(CODE, "0000000000"), 4, 1))
    X05 = Val(Mid(Format(CODE, "0000000000"), 5, 1))
    X06 = Val(Mid(Format(CODE, "0000000000"), 6, 1))
    X07 = Val(Mid(Format(CODE, "0000000000"), 7, 1))
    X08 = Val(Mid(Format(CODE, "0000000000"), 8, 1))
    X09 = Val(Mid(Format(CODE, "0000000000"), 9, 1))
    X10 = Val(Mid(Format(CODE, "0000000000"), 10, 1))
    SUM = X01 + X02 + X03 + X04 + X05 + X06 + X07 + X08 + X09 + X10
    DB.Add Array(X01 / SUM, X02 / SUM, X03 / SUM, X04 / SUM, X05 / SUM, X06 / SUM, X07 / SUM, X08 / SUM, X09 / SUM, X10 / SUM)
Next x

En DecToBin est disponible sur DecToBin pour les grands nombres comme mentionné par @Robin Mackenzie.