sbRandGeneral

"It pays to be obvious, especially if you have a reputation for subtlety." [Isaac Asimov]
If you want to create a step-wise linear random number distribution - and you can approximate any distribution with a given accuracy with such one - then you can use my user defined function sbRandGeneral.
The graphic shows a stratified sample of 10,000 runs.
080102_PB_01_General_Doc.pdf
30KB
PDF
If you are interested in how I came up with the algorithm, look into this pdf file, please.
Please read my Disclaimer.
1
Function sbRandGeneral(dMin As Double, dMax As Double, vXi As Variant, _
2
    vWi As Variant, Optional dRandom As Double = 1#) As Double
3
'Generates a random number, General distributed.
4
'Do not forget to run Randomize command from a calling VBA routine before you run this function.
5
'[see Vose: Risk Analysis, 2nd ed., p. 116]
6
'Source: https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbrandgeneral
7
'(C) (P) by Bernd Plumhoff  26-Jul-2020 PB V1.01
8
'Similar to @RISK's (C) RiskGeneral function.
9
Static bRandomized As Boolean
10
Dim i As Long, lWiCount As Long, lXiCount As Long
11
Dim dA As Double, dRand As Double, dSgn As Double
12
​
13
On Error GoTo ErrorLabelIsVariant
14
lXiCount = vXi.Count
15
lWiCount = vWi.Count
16
ErrorLabelWasVariant:
17
On Error GoTo 0
18
If lWiCount <> lXiCount Then
19
    sbRandGeneral = CVErr(xlErrValue)
20
    Exit Function
21
End If
22
If Not bRandomized Then
23
    Randomize
24
    bRandomized = True
25
End If
26
ReDim dX(0 To lXiCount + 1) As Double
27
ReDim dW(0 To lWiCount + 1) As Double
28
​
29
dX(0) = dMin
30
dX(UBound(dX)) = dMax
31
dW(0) = 0#
32
dW(UBound(dW)) = 0#
33
For i = 1 To lXiCount
34
    dX(i) = vXi(i)
35
    dW(i) = vWi(i)
36
Next i
37
​
38
'Calculate area
39
dA = 0#
40
For i = 0 To UBound(dX) - 1
41
    If dX(i) >= dX(i + 1) Or dW(i) < 0# Then
42
        sbRandGeneral = CVErr(xlErrValue)
43
        Exit Function
44
    End If
45
    dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
46
Next i
47
​
48
'Normalise weights to set area to 1
49
For i = 1 To UBound(dW) - 1
50
    dW(i) = dW(i) / dA
51
Next i
52
​
53
ReDim dF(0 To UBound(dX)) As Double
54
'Calculate border points of value ranges for
55
'cumulative inverse function
56
dF(0) = 0#
57
dA = 0#
58
For i = 0 To UBound(dX) - 1
59
    dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
60
    dF(i + 1) = dA
61
Next i
62
If dRandom = 1# Then
63
    dRand = Rnd()
64
Else
65
    dRand = dRandom
66
End If
67
i = 1
68
Do While dF(i) <= dRand
69
    i = i + 1
70
Loop
71
dSgn = Sgn(dW(i) - dW(i - 1))
72
If dSgn = 0# Then
73
    sbRandGeneral = dX(i - 1) + (dRand - dF(i - 1)) / _
74
                   (dF(i) - dF(i - 1)) * (dX(i) - dX(i - 1))
75
Else
76
    sbRandGeneral = dX(i - 1) + _
77
                   dSgn * Sqr((dRand - dF(i - 1)) * _
78
                   2# * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1)) + _
79
                   (dW(i - 1) * (dX(i) - dX(i - 1)) / _
80
                   (dW(i) - dW(i - 1))) ^ 2#) - _
81
                   dW(i - 1) * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1))
82
End If
83
Exit Function
84
​
85
ErrorLabelIsVariant:
86
lXiCount = UBound(vXi) - 1
87
lWiCount = UBound(vWi) - 1
88
Resume ErrorLabelWasVariant
89
​
90
End Function
Copied!
sbRandGeneral.xlsm
238KB
Binary

sbRandCumulative

sbRandHistogrm

Last modified 11mo ago

Copy link