Sulprobil
Search…
sbRandCumulative
If you want to create a step-wise cumulative linear random number distribution then you can use my user defined function sbRandCumulative. If you are interested in how I came up with the algorithm, look at the page for my UDF sbRandGeneral, please.
The graphic shows a stratified sample of 10,000 runs.
Please read my Disclaimer.
1
Function sbRandCumulative(dMin As Double, dMax As Double, _
2
vXi As Variant, vWi As Variant, Optional dRandom = 1#) As Double
3
'Generates a random number, Cumulative 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. 109]
6
'Source: https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/sbrandcumulative
7
'(C) (P) by Bernd Plumhoff 23-Dec-2020 PB V0.50
8
'Similar to @RISK's (C) RiskCumulative function.
9
Dim i As Long
10
Dim dA As Double
11
Dim dRand As Double
12
Dim dSgn As Double
13
14
If vWi.Count <> vXi.Count Then
15
sbRandCumulative = CVErr(xlErrValue)
16
Exit Function
17
End If
18
ReDim dX(0 To vXi.Count + 1) As Double
19
ReDim dW(0 To vWi.Count + 1) As Double
20
21
dX(0) = dMin
22
dX(UBound(dX)) = dMax
23
dW(0) = 0#
24
dW(UBound(dW)) = 1#
25
For i = 1 To vXi.Count
26
dX(i) = vXi(i)
27
dW(i) = vWi(i)
28
If dW(i) < dW(i - 1) Then
29
'Weights need to be monotonously increasing
30
sbRandCumulative = CVErr(xlErrValue)
31
Exit Function
32
End If
33
Next i
34
If dW(UBound(dW)) < dW(UBound(dW) - 1) Then
35
'Weights need to be monotonously increasing
36
sbRandCumulative = CVErr(xlErrValue)
37
Exit Function
38
End If
39
40
'Calculate area
41
dA = 0#
42
For i = 0 To UBound(dX) - 1
43
If dX(i) >= dX(i + 1) Or dW(i) < 0# Then
44
sbRandCumulative = CVErr(xlErrValue)
45
Exit Function
46
End If
47
dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
48
Next i
49
50
'Normalise weights to set area to 1
51
For i = 1 To UBound(dW)
52
dW(i) = dW(i) / dA
53
Next i
54
55
ReDim dF(0 To UBound(dX)) As Double
56
'Calculate border points of value ranges for
57
'cumulative inverse function
58
dF(0) = 0#
59
dA = 0#
60
For i = 0 To UBound(dX) - 1
61
dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
62
dF(i + 1) = dA
63
Next i
64
65
If dRandom = 1# Then
66
dRand = Rnd()
67
Else
68
dRand = dRandom
69
End If
70
71
i = 1
72
Do While dF(i) <= dRand
73
i = i + 1
74
Loop
75
dSgn = Sgn(dW(i) - dW(i - 1))
76
If dSgn = 0# Then
77
sbRandCumulative = dX(i - 1) + (dRand - dF(i - 1)) / _
78
(dF(i) - dF(i - 1)) * (dX(i) - dX(i - 1))
79
Else
80
sbRandCumulative = dX(i - 1) + _
81
dSgn * Sqr((dRand - dF(i - 1)) * _
82
2# * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1)) + _
83
(dW(i - 1) * (dX(i) - dX(i - 1)) / _
84
(dW(i) - dW(i - 1))) ^ 2#) - _
85
dW(i - 1) * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1))
86
End If
87
88
End Function
Copied!
Last modified 11mo ago
Copy link