Abstract

Nehmen Sie an, Sie wollen eine:n Lehrer:in simulieren, die Schüler bewertet. Manche Lehrer:innen 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:e Lehrer:in zu kritisch. Die Verteilung sei 40%, 30%, 20%, 10% und 0% für die Zensuren 5 bis 1. In einem anderen 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 eine:n faire:n Lehrer:in zu simulieren.

Appendix – Programmcode Redw

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function redw(ParamArray vWeights() As Variant) As Double
'Source (EN): http://www.sulprobil.com/redw_en/
'Source (DE): http://www.bplumhoff.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)-intervall
'with the given likelihood of weightings. 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