Hi i'm creating a program in vb that can generate random numbers. the thing is i want to lessen the chance to appear the highest number.
for Example i have numbers from 1-10 (in ramdom)
Number 10 the chance to appear is 10%
Number 9 the chance to appear is 20%
Number 8 the chance to appear is 30% etc..
here is my sample code.
Dim R1 As New Random
Dim d1result1 As Integer = R1.Next(1, 10)
Label2.Text = d1result1.ToString
Here is an extension method that can help you do as you want here:
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
Declaring it as an extension method means that you can call it on your Random instance, just as you would call Next, e.g.
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)
Note that, because the weightings parameter is declared as a ParamArray, those last two lines could be replaced with this:
Dim n1 = rng.NextWithWeighting(1, 4, 2, 3, 5)
If you don't want to call this as an extension method then you can call it like this instead:
Dim n1 = NextWithWeighting(rng, 1, 4, 2, 3, 5)
If you don't add the Extension attribute then you have to call it the second way.
Here's a test rig that demonstrates how to use this method and that it does as expected:
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
If you put that code into a Console app and run it repeatedly, you'll see that 1 gets generated about 100 times, 2 gets generated about 200 times, 3 gets generated about 300 times and 4 gets generated about 400 times, all in line with the specified weightings.
In your specific case, you haven't specified what the full weightings are so I can't give you the exact code but it would be something like this:
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()
where w1, w2, ..., w7 are Integer values that sum to 40.
EDIT: If you want to see how the code handles zero weightings, try changing this line:
Dim number = rng.NextWithWeighting(1, 5, 10, 20, 30, 40)
to this:
Dim number = rng.NextWithWeighting(1, 5, 10, 20, 0, 40)
or this:
Dim number = rng.NextWithWeighting(1, 5, 0, 0, 30, 0)
First, I made a little structure to hold the digits and the weight percent.
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
Then I filled a list of the structure. Next I looped through the lstWeights and added digits to a second list; adding each digit to the lst x number of times based on the percent weight.
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
Now to get the random weighted digits (1-10) Remember there are 18 ones, a16 twos, 14 threes etc. Generate a random index and get the digit at that index. For testing purposes, I added the result to yet another list.
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
Classes level variables:
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
In the form load build the first list. lstWeights
BuildWeightedList()
Call the procedure from a button.
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
Then I tested thusly:
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
The result in the immediate window:
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%,
then to test John's extension
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
result in immediate window
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%,
second try
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%,
I am obviously doing something very wrong. After correction (see comment)
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%,
