“It pays to be obvious, especially if you have a reputation for subtlety.” [Isaac Asimov]
Abstract
Wenn Sie eine schrittweise lineare Verteilung von Zufallszahlen benötigen, dann empfehle ich meine benutzerdefinierte Funktion sbRandGeneral.
Bemerkung: Man kann jede beliebige Verteilung mit einer festgelegten Mindestgenauigkeit durch eine schrittweise lineare Verteilung wie hier angeboten approximieren.
Dokumentation
Die Dokumentation zu dieser Funktion:
Bitte den Haftungsausschluss im Impressum beachten.
080102_PB_01_General_Doc.pdf [30 KB PDF Datei, ohne Gewähr]
Appendix – Programmcode sbRandGeneral
Bitte den Haftungsausschluss im Impressum beachten.
Option Explicit
Function sbRandGeneral(dMin As Double, dMax As Double, vXi As Variant, _
vWi As Variant, Optional dRandom As Double = 1#) As Double
'Generates a random number, General distributed.
'[see Vose: Risk Analysis, 2nd ed., p. 116]
'Source (EN): http://www.sulprobil.de/sbrandgeneral_en/
'Source (DE): http://www.berndplumhoff.de/sbrandgeneral_de/
'(C) (P) by Bernd Plumhoff 26-Jul-2020 PB V1.01
'Similar to @RISK's (C) RiskGeneral function.
Static bRandomized As Boolean
Dim i As Long, lWiCount As Long, lXiCount As Long
Dim dA As Double, dRand As Double, dSgn As Double
On Error GoTo ErrorLabelIsVariant
lXiCount = vXi.Count
lWiCount = vWi.Count
ErrorLabelWasVariant:
On Error GoTo 0
If lWiCount <> lXiCount Then
sbRandGeneral = CVErr(xlErrValue)
Exit Function
End If
If Not bRandomized Then
Randomize
bRandomized = True
End If
ReDim dX(0 To lXiCount + 1) As Double
ReDim dW(0 To lWiCount + 1) As Double
dX(0) = dMin
dX(UBound(dX)) = dMax
dW(0) = 0#
dW(UBound(dW)) = 0#
For i = 1 To lXiCount
dX(i) = vXi(i)
dW(i) = vWi(i)
Next i
'Calculate area
dA = 0#
For i = 0 To UBound(dX) - 1
If dX(i) >= dX(i + 1) Or dW(i) < 0# Then
sbRandGeneral = CVErr(xlErrValue)
Exit Function
End If
dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
Next i
'Normalise weights to set area to 1
For i = 1 To UBound(dW) - 1
dW(i) = dW(i) / dA
Next i
ReDim dF(0 To UBound(dX)) As Double
'Calculate border points of value ranges for
'cumulative inverse function
dF(0) = 0#
dA = 0#
For i = 0 To UBound(dX) - 1
dA = dA + (dX(i + 1) - dX(i)) * (dW(i + 1) + dW(i)) / 2#
dF(i + 1) = dA
Next i
If dRandom = 1# Then
dRand = Rnd()
Else
dRand = dRandom
End If
i = 1
Do While dF(i) <= dRand
i = i + 1
Loop
dSgn = Sgn(dW(i) - dW(i - 1))
If dSgn = 0# Then
sbRandGeneral = dX(i - 1) + (dRand - dF(i - 1)) / _
(dF(i) - dF(i - 1)) * (dX(i) - dX(i - 1))
Else
sbRandGeneral = dX(i - 1) + _
dSgn * Sqr((dRand - dF(i - 1)) * _
2# * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1)) + _
(dW(i - 1) * (dX(i) - dX(i - 1)) / _
(dW(i) - dW(i - 1))) ^ 2#) - _
dW(i - 1) * (dX(i) - dX(i - 1)) / (dW(i) - dW(i - 1))
End If
Exit Function
ErrorLabelIsVariant:
lXiCount = UBound(vXi) - 1
lWiCount = UBound(vWi) - 1
Resume ErrorLabelWasVariant
End Function
Download
Bitte den Haftungsausschluss im Impressum beachten.
sbRandGeneral.xlsm [55 KB Excel Datei, ohne jegliche Gewährleistung]