Excel UDF взвешенный RANDBETWEEN()

Ответ 1

Кажется, я совершил трагическую ошибку. Мой код был в порядке, мой подсчет был не так хорош. Я использовал SUMIF() вместо COUNTIF() в моем графике, в результате чего в массиве появились более поздние объекты (с более высоким индексом - вывод UDF, который я должен был считать, но вместо этого суммировал), получая взвешивание, пропорциональное их положение.

В ретроспективе я думаю, что кто-то гораздо более умный, чем я, вероятно, мог бы вывести это из приведенной информации. Я сказал, что {1,1,1,1} имеет a {10%:20%:30%:40%}, что отношение a {1: 2: 3: 4}, которое является точно таким же соотношением, как и индексы выходов, вычет: выходы суммированы не считаются.

Аналогично, график {1,0,0,1} с выходом {20%:0%:0%:80%}, делящий каждый процент на него индекс (20%/1, 80%/4) и Hey Presto {20%:0%:0%:20%}, или соотношение 1:1, которое я ожидал.

Что-то раздражающее, но удовлетворяющее в этом - знание ответа было все время. Полагаю, во всем этом, вероятно, есть мораль. По крайней мере, сообщение может служить предупреждением начинающим VBAers, чтобы проверить их арифметику.

Ответ 2

Попробуйте следующее:

Function Probable(v As Variant) As Long
    Application.Volatile 'remove this if you don't want a volatile function

    Dim v2 As Variant
    ReDim v2(LBound(v) To UBound(v) + 1)

    v2(LBound(v2)) = 0
    Dim i As Integer
    For i = LBound(v) To UBound(v)
        v2(i + 1) = v2(i) + v(i) / Application.Sum(v)
    Next i

    Probable = Application.WorksheetFunction.Match(Rnd(), v2, 1)
End Function

Массив v по существу является вашим outputArray.

Код принимает такой массив, как {1,0,0,1}, и преобразует его в {0,0.5,0.5,1} (обратите внимание на 0 в начале), после чего вы можете сделать MATCH, как вы предложили получить либо 1 or 4 с равной вероятностью.

Аналогично, если вы должны начать с {1,1,1,1}, он будет преобразован в {0,0.25,0.5,0.75,1} и с равной вероятностью вернет любой из 1, 2, 3 or 4.

Также обратите внимание: вы могли бы сделать это немного быстрее, если вы сохраните значение Application.Sum(v) в переменной, а не выполните вычисление для каждого значения в массиве v.

Обновление
Функция теперь принимает v как параметр - как ваш код. Я также немного изменил его, чтобы иметь дело с v, имеющим любую базу, что означает, что вы также можете запустить его с листа: =Probable({1,0,0,1}) например

Ответ 3

Это то, что я построил, следуя вашей логике. Он работает вполне нормально, обеспечивая разные результаты.

Option Explicit
Public Function TryMyRandom() As String

    Dim lngTotalChances         As Long
    Dim i                       As Long
    Dim previousValue           As Long
    Dim rnd                     As Long
    Dim result                  As Variant

    Dim varLngInputArray        As Variant
    Dim varLngInputChances      As Variant
    Dim varLngChancesReedit     As Variant

    varLngInputChances = Array(1, 2, 3, 4, 5)
    varLngInputArray = Array("a", "b", "c", "d", "e")
    lngTotalChances = Application.WorksheetFunction.Sum(varLngInputChances)
    rnd = Application.WorksheetFunction.RandBetween(1, lngTotalChances)

    ReDim varLngChancesReedit(UBound(varLngInputChances))

    For i = LBound(varLngInputChances) To UBound(varLngInputChances)
        varLngChancesReedit(i) = varLngInputChances(i) + previousValue
        previousValue = varLngChancesReedit(i)

        If rnd <= varLngChancesReedit(i) Then
            result = varLngInputArray(i)
            Exit For
        End If
    Next i

    TryMyRandom = result

End Function

Public Sub TestMe()

    Dim lng     As Long
    Dim i       As Long
    Dim dict    As Object
    Dim key     As Variant
    Dim res     As String

    Set dict = CreateObject("Scripting.Dictionary")

    For lng = 1 To 1000

        res = TryMyRandom
        If dict.Exists(res) Then
            dict(res) = dict(res) + 1
        Else
            dict(res) = 1
        End If


    Next lng

    For Each key In dict.Keys
        Debug.Print key & " ===> " & dict(key)
    Next


End Sub

Что касается вашего случая, убедитесь, что массив отсортирован. Например, в моем случае речь идет о varLngInputChances. Я не посмотрел на угловые случаи, возможно, там может быть ошибка.

Запустите TestMe sub. Это сгенерирует даже краткое изложение результатов. Если вы измените варианты на varLngInputChances = Array(1, 1, 0, 0, 1), это даст:

a ===> 329 b ===> 351 e ===> 320

что довольно неплохо.:) Здесь вы можете изменить номер выборки: For lng = 1 To 1000, он работает довольно быстро. Я только что попробовал его с 100 000 тестов.