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.

redw

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