Abstract

We present an example of a random number generation with a side condition. The sum of all created random numbers should be 1. This can be achieved by many different approaches.

Three possible approaches are:

  1. Reduce grade of freedom successively: create first random number, then the second one in range[0,1-first), the third one in [0,1-first-second), …, the last will be 1-sum of all others

  2. Create n random numbers and divide them by their sum

  3. Simulate slicing a cake: whereever you cut, you cannot distribute more than one cake

The resulting distributions look like:

sbRandSum1

You can see that the widely used simple approach to create n random numbers and then divide them by their sum is actually quite a poor choice: you mostly get numbers between 0.2 and 0.5 (see red line).

Note: A more general approach would be using the Dirichlet distribution. For a Python implementation see numpy - for our task above you would need to set size to 1: (external link!) https://numpy.org/doc/stable/reference/random/generated/numpy.random.dirichlet.html?highlight=dirichlet#numpy.random.dirichlet

Appendix sbRandSum1 Code

Please read my Disclaimer.

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

Please read my Disclaimer.

sbRandSum1.xlsm [31 KB Excel file, open and use at your own risk]