Abstract
Wir erzeugen n Zufallszahlen mit einer Bedingung: Die Summe aller erzeugten Zahlen soll 1 sein. Dies kann man mit vielen verschiedenen Ansätzen erreichen.
Drei mögliche Ansätze sind:
-
Reduziere den Freiheitsgrad sukzessive: Erzeuge die erste Zufallszahl, danach die zweite im Bereich [0,1-Erste_Zahl), dann die dritte [0,1-Erste_Zahl-Zweite_Zahl), …, die letzte Zahl muss schließlich gleich 1-Summe_aller_anderen_Zahlen sein.
-
Erzeuge n Zufallszahlen und dividiere sie durch ihre Summe.
-
Simuliere die Teilung einer Torte: wo immer man schneidet, man kann nicht mehr und nicht weniger als die ganze Torte verteilen.
Die resultierenden Verteilungen sehen so aus:
Sie können leicht erkennen, dass der weitverbreitete Ansatz mit n Zufallszahlen dividiert durch ihre Summe eine schlechte Wahl ist: Sie erhalten meist Zahlen zwischen 0,2 und 0,5 (siehe die rote Kurve).
Bemerkung: Ein genereller Ansatz wäre die Dirichlet Verteilung. Für eine Impementierung mit Python siehe numpy - für unsere obige Ausgabe müsste der Parameter size auf 1 gesetzt werden: (externer Link!) https://numpy.org/doc/stable/reference/random/generated/numpy.random.dirichlet.html?highlight=dirichlet#numpy.random.dirichlet
Appendix Programmcode sbRandSum1
Bitte den Haftungsausschluss im Impressum beachten.
Option Explicit
Function sbRandSum1(ByVal lDist As Long, _
Optional ByVal lCount As Long, _
Optional bVolatile As Boolean = False) As Variant
'sbRandSum1 produces lCount (or the number of selected cells if
'called from a worksheet range) random numbers which sum up to 1.
'Possible values of lDist to specify desired distribution:
' 1 = reduce degree of freedom linearly
' 2 = divide lCount random numbers by their sum
' 3 = lCount-1 random cuts of (0,1)-interval
'If TypeName(Application.Caller) <> "Range" Then lCount has to be set.
'It specifies the count of summands which have to have the sum of 1.
'Source (EN): https://www.sulprobil.com/sbrandsum1_en/
'Source (DE): https://www.bplumhoff.de/sbrandsum1_de/
'(C) (P) by Bernd Plumhoff 02-Aug-2020 PB V0.4
Static bRandomized As Boolean
Dim bRowWise As Boolean
Dim vA As Variant, vT As Variant
Dim i As Long, j As Long
Dim dSum As Double
If bVolatile Then Application.Volatile
If Not bRandomized Then
Randomize
bRandomized = True
End If
If TypeName(Application.Caller) <> "Range" Then
If lCount < 1 Then
sbRandSum1 = CVErr(xlErrRef)
Exit Function
End If
bRowWise = False
Else
With Application.Caller
lCount = .Rows.Count
bRowWise = True
If lCount < .Columns.Count Then
lCount = .Columns.Count
bRowWise = False
End If
If lCount = 1 Then
sbRandSum1 = 1
Exit Function
End If
End With
End If
ReDim vA(1 To lCount) As Variant
Select Case lDist
Case 1
ReDim nRand(1 To lCount) As Long
For i = 1 To lCount
nRand(i) = i
Next i
For i = 1 To lCount - 1
j = Int(Rnd * (lCount - i + 1)) + i
vA(nRand(j)) = Rnd * (1# - dSum)
dSum = dSum + vA(nRand(j))
nRand(j) = nRand(i)
Next i
vA(nRand(lCount)) = 1# - dSum
Case 2
For i = 1 To lCount
vA(i) = Rnd
dSum = dSum + vA(i)
Next i
For i = 1 To lCount
vA(i) = vA(i) / dSum
Next i
Case 3
For i = 1 To lCount - 1
vA(i) = Rnd
j = i - 1
Do While j > 0
If vA(j) > vA(j + 1) Then
vT = vA(j + 1)
vA(j + 1) = vA(j)
vA(j) = vT
End If
j = j - 1
Loop
Next i
vA(lCount) = 1# - vA(lCount - 1)
i = lCount - 1
Do While i > 1
vA(i) = vA(i) - vA(i - 1)
i = i - 1
Loop
Case Else
sbRandSum1 = CVErr(xlErrValue)
Exit Function
End Select
If bRowWise Then vA = Application.WorksheetFunction.Transpose(vA)
sbRandSum1 = vA
End Function
Download
Bitte den Haftungsausschluss im Impressum beachten.
sbRandSum1.xlsm [31 KB Excel Datei, ohne jegliche Gewährleistung]