與某些概率視覺基礎VBA生成數字

Question

我有

26％18％26％20％10％

一些概率和我想（在一定範圍內隨機地）以產生一些數字概率組。

我已經做到了前面的80％，2個概率和20％象下面這樣：

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

但我不知道怎麼做，有2點以上的概率！

Answer 1

在[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 2

你可以做得非常相似。您可以使用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 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)