Question

我需要创建一个具有以下特征的随机向量集合（VBA）：a）每个向量是一个10维数组; b）矢量的所有非零分量都是相同的值。在这种情况下，集合必须具有所有可能的向量。

我开始通过向这个集合逐个添加向量来实现这一点：

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)
    ...

依此类推，直到获得最后一个向量（构成整个第十组）：

...
'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)

好吧，你可能知道，这个集合最终会有1023个向量，所以我的问题非常简单（我相信这个问题是唯一的简单问题）：有没有办法做到这一点，而没有明确写出所有的1023个载体？

让我告诉你到目前为止我得到了什么：

首先，我可以通过使用1而不是分数组件获得相同的数组来获得结果。

其次，我不能为第一套本身做到这一点。我怎样才能做出像

这样的事情

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

努力给出我假装的结果？请注意，我知道最后一段代码没有给我第一组向量...这只是为了让你知道我在问什么。

在第三名，我认为一旦我得到第一组问题的帮助，我就能够为其他人做同样的事情。尽管如此，如果你急于帮助我完成所有剧本到第十集，那么我该说不，呃呃！

我知道这个有点棘手！任何帮助将非常感激。而且，一如既往，提前谢谢大家。

Answer 1

您可以像这样解决问题：

对于每个＆＃39;设置＆＃39;数组合的数量由N Choose K给出，其中N为10，K为该组的第N个数。
我们可以通过求和获得组合总数10选择1 + 10选择2 + 10选择3等一直到10选择10.这会增加到1023，如您所见。
将每个数组视为10 0和1的二进制字符串，然后您可以循环1到1023并获得相当于该十进制数的10位二进制数 - 它将从0000000001到1111111111一直计数。
将二进制数作为字符串获取并计算字符串中的1。 1的数量为您提供该数字所属的集合，例如三个1表示根据你的例子，数组将在你的第三组中。
循环遍历字符串中的每个字符，并为每个字符添加您计数到该插槽中的数组的1的倒数。例如。如果有三个1，则每个阵列槽获得1/3。对于每个0，将0添加到该插槽。这可确保数组中的项添加到1。
将数组添加到集合中，然后循环

下面的示例代码 - 我评论了几个对此任务有用的代码链接：

N Choose K with VB.NET（很容易移植到VBA）
DecToBin for larger numbers（优于WorksheetFunction.Dec2Bin）

代码：

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

感谢@Robin Mackenzie我设法找到一种编写简单代码的方法来创建我假装的数组集合。这是我的方式，仅供将来参考：

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

DecToBin功能可在DecToBin for larger numbers上找到，如@Robin Mackenzie所述。

使用排列来对随机向量进行排序

2 个答案: