Sulprobil
Search…
sbRandTrigen
The graphic shows a stratified sample of 10,000 runs
Please notice that sbRandTrigen needs and calls sbRandTriang.
071228_PB_02_Trigen_Doc.pdf
37KB
PDF
If you like to know how I came up with the algorithm for this code, look into this pdf file, please.
Please read my Disclaimer.
1
Function sbRandTrigen(dBottom As Double, dMode As Double, _
2
dTop As Double, dBottomPerc As Double, _
3
dTopPerc As Double, Optional dRandom = 1#) As Double
4
'Generates dMin random number, Triang distributed
5
'with given first and last decile
6
'[see Vose: Risk Analysis, 2nd ed., p. 129]
7
'Reverse("moc.LiborPlus.www") PB 19-Nov-2011 V0.32 (C) (P) by Bernd Plumhoff
8
'Similar to @RISK's (C) RiskTrigen function.
9
'sbRandTrigen(bottom, mode, top, bottom percentile, top percentile)
10
'specifies a triangular distribution with three points — one
11
'at the mode and two at the specified bottom and top percentiles.
12
'The bottom percentile and top percentile are values between
13
'0 and 100. Each percentile value gives the percentile of the
14
'total area under the triangle that is on the left side of the
15
'given point.
16
'Example:
17
'sbRandTrigen(1,8,10,20,95) will call
18
'sbRandTriang(-6.13212712795534, 8, 11.8648937411641).
19
20
Static dBottomLast As Double
21
Static dModeLast As Double
22
Static dTopLast As Double
23
Static dBottomPercLast As Double
24
Static dTopPercLast As Double
25
Static dMin As Double
26
Static dMax As Double
27
Dim dMaxNew As Double
28
Dim da0 As Double, da1 As Double, da2 As Double
29
Dim da3 As Double, da4 As Double
30
Dim dfe As Double, df1e As Double
31
Dim dBottomPerc2 As Double, dTopPerc2 As Double
32
Dim i As Long
33
34
'Application.Volatile '[Un]Comment if you need this
35
If dBottom = dBottomLast And dMode = dModeLast And dTop = dTopLast _
36
And dBottomPerc = dBottomPercLast And dTopPerc = dTopPercLast _
37
And Not IsError(dMin) Then
38
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
39
Exit Function
40
End If
41
42
dBottomLast = dBottom
43
dModeLast = dMode
44
dTopLast = dTop
45
dBottomPercLast = dBottomPerc
46
dTopPercLast = dTopPerc
47
48
dBottomPerc2 = dBottomPerc / 100#
49
dTopPerc2 = 1# - dTopPerc / 100#
50
If dMode <= dBottom Or dTop <= dMode Then
51
dMin = CVErr(xlErrValue) 'Trigger rerun next time
52
sbRandTrigen = CVErr(xlErrValue)
53
Exit Function
54
End If
55
If dBottomPerc2 < 0# Or dTopPerc2 < 0# Then
56
dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
57
sbRandTrigen = CVErr(xlErrValue)
58
Exit Function
59
End If
60
61
If dTopPerc2 = 0# Then
62
If dBottomPerc2 = 0# Then
63
sbRandTrigen = sbRandTriang(dBottom, dMode, dTop, dRandom)
64
Exit Function
65
End If
66
sbRandTrigen = sbRandTrigen(dBottom, dMode, dTop, dBottomPerc2, dTopPerc2)
67
Exit Function
68
End If
69
70
da4 = dBottomPerc2 * dTopPerc2 - dBottomPerc2 + 1# - 2# * dTopPerc2 + dTopPerc2 ^ 2#
71
da3 = -2# * dBottomPerc2 * dTopPerc2 * dTop - 2# * dBottomPerc2 * dTopPerc2 * dMode - _
72
4# * dTop + 4# * dBottomPerc2 * dTop + 2# * dTopPerc2 * dMode + 4# * dTopPerc2 * _
73
dTop + 2# * dTopPerc2 * dBottom - 2# * dTopPerc2 ^ 2# * dMode - _
74
2# * dTopPerc2 ^ 2# * dBottom
75
da2 = dBottomPerc2 * dTopPerc2 * dTop ^ 2# + 4# * dBottomPerc2 * dTopPerc2 * dMode * _
76
dTop + dBottomPerc2 * dTopPerc2 * dMode ^ 2# - 6# * dBottomPerc2 * dTop ^ 2# + _
77
6# * dTop ^ 2# - 4# * dTopPerc2 * dMode * dTop - 2# * dTopPerc2 * dTop ^ 2# - 2# * _
78
dTopPerc2 * dBottom * dMode - 4# * dTopPerc2 * dBottom * dTop + dTopPerc2 ^ 2# * _
79
dMode ^ 2# + 4# * dTopPerc2 ^ 2# * dBottom * dMode + dTopPerc2 ^ 2# * dBottom ^ 2#
80
da1 = -2# * dBottomPerc2 * dTopPerc2 * dMode * dTop ^ 2# - 2# * dBottomPerc2 * dTopPerc2 * _
81
dMode ^ 2# * dTop + 4# * dTop ^ 3# * dBottomPerc2 - 4# * dTop ^ 3# + 2# * dTopPerc2 * _
82
dMode * dTop ^ 2# + 4# * dTopPerc2 * dBottom * dMode * dTop + 2# * dTopPerc2 * _
83
dBottom * dTop ^ 2# - 2# * dTopPerc2 ^ 2# * dBottom * dMode ^ 2# - 2# * _
84
dTopPerc2 ^ 2# * dBottom ^ 2# * dMode
85
da0 = dBottomPerc2 * dTopPerc2 * dMode ^ 2# * dTop ^ 2# - dBottomPerc2 * dTop ^ 4# + dTop ^ 4# - _
86
2# * dTopPerc2 * dBottom * dMode * dTop ^ 2# + dTopPerc2 ^ 2# * dBottom ^ 2# * dMode ^ 2#
87
88
dMax = dTop + (dTop - dMode) / (1# - dTopPerc2) ^ 2#
89
90
'Newton iteration
91
Do While Abs(dMaxNew - dMax) > 0.000000000001
92
93
i = i + 1
94
If i > 30 Then
95
If Abs(dfe) > 0.000000000001 Then
96
dMin = CVErr(xlErrDiv0) 'Trigger rerun next time
97
sbRandTrigen = CVErr(xlErrValue)
98
Exit Function
99
Else
100
Exit Do
101
End If
102
End If
103
dMaxNew = dMax
104
dfe = da4 * dMaxNew ^ 4# + da3 * dMaxNew ^ 3# + da2 * dMaxNew ^ 2# + da1 * dMaxNew + da0
105
df1e = 4# * da4 * dMaxNew ^ 3# + 3# * da3# * dMaxNew ^ 2# + 2# * da2 * dMaxNew + da1
106
dMax = dMax - dfe / df1e
107
108
Loop
109
110
dMin = dMax - (dMax - dTop) ^ 2# / dTopPerc2 / (dMax - dMode)
111
sbRandTrigen = sbRandTriang(dMin, dMode, dMax, dRandom)
112
End Function
Copied!
Last modified 1yr ago
Copy link