Question

我有一些概率

26％18％26％20％10％

我希望根据概率组生成一些数字（在一定范围内随机）。

我之前已经完成了以下两种概率：80％和20％，如下所示：

If rnd*100 < 80 then Output = 2 
Else  output = 10
End if

但我不确定如何以超过2个概率来做到这一点！

Answer 1

你可以做得非常相似。您可以利用vba的开关案例来代替编写巨大的if子句：

Select (rnd*100)
    Case 0 to 26:
        ' do prop 1
    Case 26 to 44:
        ' do prop 2
    Case 44 to 70:
        ' do prop 3
    Case 70 to 90:
        ' do prop 4
    Case 90 to 100:
        ' do prop 5
End Select

Answer 2

在[0,1]中生成一个随机数。开始添加概率（0.26,0.18等），直到超过所选数字。一旦发生这种情况 - 选择范围内的相应数字。

以下函数传递两个数组（假设长度相同）。第一个包含要从中采样的项目范围（不一定是数字），第二个数组是相应的概率：

Function RandItem(items As Variant, probs As Variant) As Variant
    Dim i As Long, sum As Double
    Dim spin As Double

    spin = Rnd()
    For i = LBound(probs) To UBound(probs)
        sum = sum + probs(i)
        If spin <= sum Then
            RandItem = items(i)
            Exit Function
        End If
    Next i
    'if you get here:
    RandItem = items(UBound(probs))
End Function

可以像以下一样进行测试：

Sub test()
    Randomize
    Dim i As Long, v As Variant
    ReDim v(1 To 50)
    For i = 1 To 50
        v(i) = RandItem(Array(1, 2, 3, 4, 5), Array(0.26, 0.18, 0.26, 0.2, 0.1))
    Next i
    Debug.Print Join(v)
End Sub

具有典型输出：

2 4 2 1 1 4 3 4 2 3 2 4 5 1 1 3 3 4 3 3 3 4 4 2 4 4 1 2 3 1 2 3 5 2 3 4 5 2 3 2 3 4 1 1 1 2 1 4 3 2

这是一个条形图，显示1000个随机选择（使用相同的5个概率）：

正如您所看到的，它在匹配目标概率方面做得很好。

Answer 3

你可以利用Median()函数的优点，如下所示：

probs = Array(0.26, 0.18, 0.26, 0.2, 0.1)
vals = Array(1, 2, 3, 4, 5)

For i = 0 To UBound(probs) - 1
    If prob = WorksheetFunction.Median(prob, probSum, probSum + probs(i)) Then Exit For
    probSum = probSum + probs(i)
Next I
output = vals(i)

完整且（希望）优化的示例可以是以下

Sub main()
    Dim vals As Variant, probs As Variant, probsSum As Variant
    Dim genVals(1 To 50) As Variant
    Dim i As Long

    probs = Array(0.26, 0.18, 0.26, 0.2, 0.1)
    vals = Array(1, 2, 3, 4, 5)

    probsSum = setSums(probs) '<~~ calculate the probs sum once for all!

    For i = 1 To 50
        Randomize'<~~ 'randomize' before picking a Rnd() if you need a different seed for each one
        genVals(i) = GetVals(Rnd(), probsSum, vals)
    Next i        
End Sub


Function GetVals(prob As Double, probsSum As Variant, vals As Variant) As Variant
    Dim i As Long

    For i = 0 To UBound(probsSum) - 1
        If prob = WorksheetFunction.Median(prob, probsSum(i), probsSum(i + 1)) Then Exit For
    Next i
    GetVals= vals(i)        
End Function


Function setSums(arr As Variant) As Variant
    Dim i As Long
    ReDim sumArr(0 To UBound(arr) + 1)

    sumArr(0) = 0
    For i = 0 To UBound(arr)
        sumArr(i + 1) = sumArr(i) + arr(i)
    Next i
    setSums = sumArr
End Function

Answer 4

这是一种使用定义的分布随机选择值的简单方法：

Dim values(), probabilities()

' define the values and the cumultated probabilities for 26% 18% 26% 20% 10%
values = VBA.Array("a", "b", "c", "d", "e")
probabilities = VBA.Array(0, 0.26, 0.44, 0.7, 0.9)

' generate one value
Debug.Print values(Application.Match(Rnd, probabilities) - 1)

生成具有一定概率的数字视觉基础知识vba

4 个答案: