如何获取带有百分比的随机数以显示

Question

您好，我正在用 vb 创建一个可以生成随机数的程序。问题是我想减少出现最高数字的机会。

例如，我有 1-10 的数字（随机数）

10号出现的几率是10%

9号出现的几率是20%

8号出现的几率是30% 等等。

这是我的示例代码。

        Dim R1 As New Random
        Dim d1result1 As Integer = R1.Next(1, 10)
        Label2.Text = d1result1.ToString

Answer 1

首先，我做了一个小结构来保存数字和重量百分比。

Structure Weights

        Public Sub New(num As Integer, per As Integer)
            Number = num
            Percent = per
        End Sub
        Public Number As Integer
        Public Percent As Integer
End Structure

然后我填写了一个结构列表。接下来，我遍历 lstWeights 并将数字添加到第二个列表中；根据重量百分比将每个数字添加到前 x 次。

Private Sub BuildWeightedList()
        lstWeights.Add(New Weights(10, 2))
        lstWeights.Add(New Weights(9, 4))
        lstWeights.Add(New Weights(8, 5))
        lstWeights.Add(New Weights(7, 8))
        lstWeights.Add(New Weights(6, 9))
        lstWeights.Add(New Weights(5, 11))
        lstWeights.Add(New Weights(4, 13))
        lstWeights.Add(New Weights(3, 14))
        lstWeights.Add(New Weights(2, 16))
        lstWeights.Add(New Weights(1, 18))
        'Add digits to lst; each digit is added as many times as it weight
        For Each item As Weights In lstWeights
            For x As Integer = 1 To item.Percent
                lst.Add(item.Number)
            Next
        Next
End Sub

现在获取随机加权数字 (1-10) 记住有 18 个，a16 个二，14 个三等。生成一个随机索引并获取该索引处的数字。出于测试目的，我将结果添加到另一个列表中。

Private Sub WeightedRandom()
        Dim ListCount As Integer = lst.Count
        Dim index As Integer = R1.Next(0, ListCount)
        Dim d1result1 As Integer = lst(index)
        lstResult.Add(d1result1)
End Sub

类级变量：

Private lstWeights As New List(Of Weights)
Private lst As New List(Of Integer)
Private lstResult As New List(Of Integer)
Private R1 As New Random

在表单加载构建第一个列表。 lstWeights

BuildWeightedList()

从按钮调用过程。

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        For x = 0 To 10000
            WeightedRandom()
        Next
        TestWeighted()
         MessageBox.Show("Done")
End Sub

然后我就这样测试了：

Private Sub TestWeighted()
        Dim c10, c9, c8, c7, c6, c5, c4, c3, c2, c1 As Integer
        For Each x As Integer In lstResult
            Select Case x
                Case 1
                    c1 += 1
                Case 2
                    c2 += 1
                Case 3
                    c3 += 1
                Case 4
                    c4 += 1
                Case 5
                    c5 += 1
                Case 6
                    c6 += 1
                Case 7
                    c7 += 1
                Case 8
                    c8 += 1
                Case 9
                    c9 += 1
                Case 10
                    c10 += 1
            End Select
        Next
        Dim divisor As Integer = lstResult.Count
        Debug.Print($"1 is {c1 / divisor:P00}, 2 is {c2 / divisor:P00}, 3 is {c3 / divisor:P00}, 4 is {c4 / divisor:P00}, 5 is {c5 / divisor:P00}, 6 is {c6 / divisor:P00}, 7 is {c7 / divisor:P00}, 8 is {c8 / divisor:P00}, 9 is {c9 / divisor:P00}, 10 is {c10 / divisor:P00},")
End Sub

即时窗口中的结果：

1 is 18%, 2 is 17%, 3 is 13%, 4 is 13%, 5 is 11%, 6 is 9%, 7 is 8%, 8 is 5%, 9 is 4%, 10 is 2%,

然后测试 John 的扩展

Private Sub Testjmcilhinney()
        Dim R1 As New Random 'CORRECTION - moved this to class level
        'Dim weightings = {100, 90, 80, 70, 60, 50, 40, 30, 20, 10}
        'Took the weights provided by the OP and divided by 550 (total of his percentages) to get weightings totaling 100
        Dim weightings = {18, 16, 14, 13, 11, 9, 8, 5, 4, 2} 'Totals 100%
        Dim d1result1 As Integer = R1.NextWithWeighting(1, 11, weightings)
        lstResult.Add(d1result1)
End Sub

 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        For x = 0 To 10000
         Testjmcilhinney()
        Next
        TestWeighted()
        MessageBox.Show("Done")
End Sub

立即生成窗口

1 is 60%, 2 is 0%, 3 is 21%, 4 is 0%, 5 is 0%, 6 is 19%, 7 is 0%, 8 is 0%, 9 is 0%, 10 is 0%,

第二次尝试

1 is 0%, 2 is 0%, 3 is 0%, 4 is 53%, 5 is 0%, 6 is 3%, 7 is 0%, 8 is 44%, 9 is 0%, 10 is 0%,

我显然做错了什么。 更正后（见评论）

1 is 19%, 2 is 17%, 3 is 14%, 4 is 13%, 5 is 11%, 6 is 9%, 7 is 9%, 8 is 4%, 9 is 4%, 10 is 1%,

Answer 2

这是一个扩展方法，可以帮助你在这里做你想做的事：

Imports System.Runtime.CompilerServices

Public Module RandomExtensions

    ''' <summary>
    ''' Returns a random integer that is within a specified range where each value in that range has a weighted probablity.
    ''' </summary>
    ''' <param name="source">
    ''' The <see cref="Random"/> object to use to generate the number.
    ''' </param>
    ''' <param name="minValue">
    ''' The inclusive lower bound of the random number returned.
    ''' </param>
    ''' <param name="maxValue">
    ''' The exclusive upper bound of the random number returned. maxValue must be greater than or equal to minValue.
    ''' </param>
    ''' <param name="weightings">
    ''' The weightings for each of the possible outcomes.
    ''' </param>
    ''' <returns>
    ''' A 32-bit signed integer greater than or equal to minValue and less than maxValue; that is, the range of return values includes minValue but not maxValue. If minValue equals maxValue, minValue is returned.
    ''' </returns>
    ''' <remarks>
    ''' A non-negative weighting must be provided for each possible outcome.  Weightings are a proportion of the total of all weightings.  They are not percentages.
    ''' For instance, if there are three possible outcomes and the weightings are 1, 2 and 3 then the first outcome will result in about 1/6 of the time, the second outcome will result about 1/3 of the time and the third outcome will result about 1/2 of the time.
    ''' </remarks>
    <Extension>
    Public Function NextWithWeighting(source As Random,
                                      minValue As Integer,
                                      maxValue As Integer,
                                      ParamArray weightings As Integer()) As Integer
        If minValue > maxValue Then
            Throw New ArgumentOutOfRangeException("'minValue' cannot be greater than maxValue.", "minValue")
        End If

        If maxValue > minValue AndAlso weightings.Length <> maxValue - minValue Then
            Throw New ArgumentException("A weighting must be provided for all possible outcomes.", "weightings")
        End If

        If weightings.Any(Function(n) n < 0) Then
            Throw New ArgumentException("All weightings must be greater than zero.", "weightings")
        End If

        Dim totalWeightings As Integer

        Try
            totalWeightings = weightings.Sum()
        Catch ex As OverflowException
            Throw New ArgumentOutOfRangeException("The sum of all weightings must not be greater than Int32.MaxValue.", ex)
        End Try

        If totalWeightings = 0 Then
            Throw New ArgumentException("The sum of all weightings must be greater than zero.", "weightings")
        End If

        If minValue = maxValue OrElse minValue = maxValue + 1 Then
            'There is only one possible value.
            Return minValue
        End If

        'Generate a number in the range 0 to 1 less than the total weightings.
        Dim number = source.Next(totalWeightings)

        Dim runningWeighting As Integer

        'For each weighting, check whether the number generated falls in that interval.
        For i = 0 To weightings.GetUpperBound(0)
            'Sum the weightings so far.
            'E.g. if the weightings are 10, 20, 30 and 40 then the running weighting for each iteration will be:
            'i = 0: runningWeighting = 0 + 10 = 10
            'i = 1: runningWeighting = 10 + 20 = 30
            'i = 2: runningWeighting = 30 + 30 = 60
            'i = 3: runningWeighting = 60 + 40 = 100
            runningWeighting += weightings(i)

            'There is no interval until the running weighting is greater than zero.
            If runningWeighting > 0 AndAlso number <= runningWeighting Then
                'The number generated falls within the current weighting interval so get the value from the original range that corresponds to that interval.
                Return minValue + i
            End If
        Next

        'If we end up here then something was wrong with the interval and/or the weightings.
        'The validation at the top of the method should ensure that such cases are always caught first.
        Throw New Exception("An unexpected error occurred.")
    End Function

End Module

将其声明为扩展方法意味着您可以在 Random 实例上调用它，就像调用 Next 一样，例如

Dim rng As New Random

'Get an unweighted random number in the range 1 - 3.
Dim n1 = rng.Next(1, 4)

'Use weightings of 20%, 30% and 50% for values 1, 2 and 3 respectively.
Dim weightings = {2, 3, 5}

'Get a weighted random number in the range 1 - 3.
Dim n1 = rng.NextWithWeighting(1, 4, weightings)

请注意，因为weightings 参数被声明为ParamArray，所以最后两行可以替换为：

Dim n1 = rng.NextWithWeighting(1, 4, 2, 3, 5)

如果您不想将其作为扩展方法调用，则可以这样调用：

Dim n1 = NextWithWeighting(rng, 1, 4, 2, 3, 5)

如果不添加Extension 属性，则必须以第二种方式调用它。

这是一个演示如何使用此方法并按预期执行的测试台：

Module Module1

    Sub Main()
        Dim rng As New Random
        Dim countsByNumber As New Dictionary(Of Integer, Integer) From {{1, 0}, {2, 0}, {3, 0}, {4, 0}}

        'Generate 1000 random numbers in the range 1 - 4 inclusive and count the number of times each result is generated.
        'Use the following weighting: 1 - 10%, 2 - 20%, 3 - 30%, 4 - 40%
        For i = 1 To 1000
            Dim number = rng.NextWithWeighting(1, 5, 10, 20, 30, 40)

            'The above line could also be written like this:
            'Dim weightings = {10, 20, 30, 40}
            'Dim number = rng.NextWithWeighting(1, 5, weightings)

            'Increment the count for the generated number.
            countsByNumber(number) += 1
        Next

        'Output the counts to see if they are close to the weightings.
        For Each number In countsByNumber.Keys
            Console.WriteLine("{0}: {1}", number, countsByNumber(number))
        Next

        Console.ReadLine()
    End Sub

End Module

如果您将该代码放入控制台应用程序并重复运行，您会看到 1 生成了大约 100 次，2 生成了大约 200 次，3 生成了大约 300 次，4 生成了大约 400 次，都符合规定的权重。

在你的具体情况下，你没有指定完整的权重是多少，所以我不能给你确切的代码，但它会是这样的：

Dim R1 As New Random
Dim weightings = {w1, w2, w3, w4, w5, w6, w7, 30, 20, 10}
Dim d1result1 As Integer = R1.NextWithWeighting(1, 11, weightings)

Label2.Text = d1result1.ToString()

其中w1、w2、...、w7 是 Integer 的总和为 40。

编辑：如果您想查看代码如何处理零权重，请尝试更改此行：

Dim number = rng.NextWithWeighting(1, 5, 10, 20, 30, 40)

到这里：

Dim number = rng.NextWithWeighting(1, 5, 10, 20, 0, 40)

或者这个：

Dim number = rng.NextWithWeighting(1, 5, 0, 0, 30, 0)