Abstract
Nehmen Sie an, Sie wollen einen Lehrer simulieren, der seine Schüler bewertet. Manche Lehrer vermeiden extreme Zensuren - nehmen wir an, dass sie eine 5 in 2% der Fälle vergeben, eine 4 in 8% der Fälle, eine 3 in 80% der Fälle, eine 2 in 8% und eine 1 in 2%. Im nächsten Fall ist ein Lehrer zu kritisch. Die Verteilung sei 40%, 30%, 20%, 10% und 0% für die Zensuren 5 bis 1. In einem anderen Fall werden vielleicht zu 60% Zweien und zu 40% Einsen verteilt. Und schließlich bietet jemand eine faire Verteilung an (10%, 20%, 40%, 20%, 10%).
Wie können Sie Zufallszahlen für diese genannten Verteilungen erzeugen?
Verwenden Sie die hier genannte Funktion redw(), die Zufallszahlen mit äquidistanten Gewichten erzeugt. Diese Funktion würde z. B. mit
=GANZZAHL(1+5*redw(10;20;40;20;10))
aufgerufen werden, um einen fairen Lehrer zu simulieren.
Appendix – Programmcode Redw
Bitte den Haftungsausschluss im Impressum beachten.
Function redw(ParamArray vWeights() As Variant) As Double
'Source (EN): https://www.sulprobil.de/redw_en/
'Source (DE): https://www.berndplumhoff.de/redw_de/
'(C) (P) by Bernd Plumhoff 09-Dec-2009 PB V0.50
'Produces random numbers with equidistant weights. Redw expects a vector of n random
'weights of type double and returns a random number of type double. This random
'number will lie in the given equidistant n-split-range of the [0,1)-interval with
'the given likelihood of weightings. Call Randomize before calling redw! Examples:
'a) redw(0,1,0,0,0,0,0,0,0,0) will return a random number d, 0.1 <= d < 0.2
'b) redw(2,1) will return a random number between 0 and 0.5 twice as
' often as a random number between 0.5 and 1.
'c) redw(0,1,0) will return a random number d, 0.333333333333333 <= d < 0.666666666666666.
'd) redw(15.4,15.4,15.4,15.4,15.4,7.7,7.7,7.7,0,0) would return a random value between
' 0 and 0.8, first 5 deciles with double likelihood than decile 6-8.
Dim i As Long
Dim dw As Double
ReDim dwi(0 To UBound(vWeights) + 2) As Double
dw = 0#
dwi(0) = 0#
For i = 0 To UBound(vWeights)
If vWeights(i) < 0# Then 'A negative weight is an error
redw = CVErr(xlErrValue)
Exit Function
End If
dw = dw + vWeights(i) 'Calculate sum of all weights
dwi(i + 1) = dw 'Calculate sum of weights till i
Next i
redw = dw * Rnd
'i = UBound(vWeights) + 1 'i already equals UBound(vWeights) + 1, you may omit this statement.
Do While redw < dwi(i)
i = i - 1
Loop
redw = (CDbl(i) + (redw - dwi(i)) / vWeights(i)) / (CDbl(UBound(vWeights) + 1))
End Function