Vb.net 如何获得显示百分比的随机数

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

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

例如，我有1-10的数字（在ramdom中）

第十，出现的几率是10%

第九，出现的几率是20%

第八，出现的几率是30% 等等

这是我的示例代码。

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

---

这里有一个扩展方法，可以帮助您在这里随心所欲：

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

注意，由于

权重

参数被声明为

参数数组

，最后两行可以替换为：

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

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

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

如果不添加

扩展名

属性，则必须使用第二种方法调用它

下面是一个试验台，它演示了如何使用此方法，并按照预期进行：

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

是总和为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)

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

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并将数字添加到第二个列表中；根据重量百分比将每个数字添加到lst 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个1，16个2，14个3等。生成一个随机索引并获取该索引处的数字。出于测试目的，我将结果添加到另一个列表中

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

在load表单中，构建第一个列表。配重

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%,

我显然做错了什么事。
修正后（见注释）

请使用我的delaclared变量。我不明白。请注意，只要至少有一个权重大于零，上述方法也可以处理单个零权重。我这样称呼正确吗？我没有得到我期望的结果。Dim weightings={18,16,14,13,11,9,8,5,4,2}Dim d1result1为Integer=R1。下一步，首先，如果要格式化注释中的代码，请将其包装为`字符（与~，在同一个键上）。至于这个问题，你期望的是什么？结果与你的期望不相关的具体原因是什么？您是否适当地修改了我的测试设备以测试这些权重？
Dim weightings={18,16,14,13,11,9,8,5,4,2}
Dim d1result1为Integer=R1。nextwighting（1,11，权重）
我期望权重中的百分比，但得到的百分比不同。您应该从了解
随机
类的工作原理开始。如果您拨打
Next（1，10）
，则您需要的号码范围为1-9。
minValue
参数是包含的，但是
maxValue
参数是独占的，这在文档中以及Intellisense中都有明确说明。如果希望生成最大值10，则必须将11传递给
maxValue
参数。有趣的事实：百分比表示每百分之多少。如果将3个示例值相加，总和已经是60%，下一个值将是40%，从而耗尽权重。如果你做了
等…
减到1，重量将是100%。明白了！将Dim R1作为新的随机变量移动到类级别，然后结果才有意义。这是一个紧密的循环，我用jmchilinney代码得到了重复的值。看见
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%,