您好我在vb中创建了一个可以生成随机数的程序。问题是我想减少出现最高数字的机会。
例如，我有1-10的数字（在ramdom中）
10号出现的机会是10％
9号出现的机会是20％
8号出现的几率是30％ 等。
这是我的示例代码。
Dim R1 As New Random
Dim d1result1 As Integer = R1.Next(1, 10)
Label2.Text = d1result1.ToString
答案 0 :(得分：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)
答案 1 :(得分：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并将数字添加到第二个列表中;根据重量百分比将每个数字添加到第l次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%,