[RESOLVED] Randomly selected item from list which have a %

Basically, I know how to get a random number but I'm not sure how to select an item from a list which has a percentage of being randomly selected.

EG. If this is my list

Red - 10%
Blue - 25%
Green - 7%
Yellow - 58%

I then declare a random which selects an item based off their percentage. So yellow is likely to be selected and green the least likely.

How would I go around doing that.



[RESOLVED]

I used some of these posts solutions and wrote the code myself. Its minimal which i like and it works on bigger decimal probabilities.

Code:

---

Dim useRandom As New Random
        Select Case (Math.Round(useRandom.NextDouble(), 2))
            Case 0 To 0.25
                MsgBox("Red")
            Case 0.26 To 0.5
                MsgBox("Blue")
            Case 0.51 To 0.75
                MsgBox("Green")
            Case 0.76 To 1
                MsgBox("Yellow")
        End Select

---

Select a random number from 1 to 100, then use a select case. 1-10 is Red, 11-35 is Blue and so on.

Yeah I had that idea but for some reason I thought they may of been a easier way because I'll have to figure out what number ranges equals what % because some get really small. Thanks

It's just adding up.

1 to P1
P1+1 to P1 + P2
P1+P2+1 to P1+P2+P3

If you have fractional percentages (eg. 30.5% then multiply everything by 10 as many times as it takes to make all the values integers)

What is done in role playing board/computer games is a dice is rolled to determine an outcome. JMcIlhinney has a code bank post here that is a Die(singular of dice) class. I would be tempted to use that.

here's my attempt at a solution:

Code:

---

Imports System.Text.RegularExpressions

Public Class Form1

    Dim r As New Random
    Dim colors As New Dictionary(Of Integer, String)

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        colors.Add(7, "Green")
        colors.Add(10, "Red")
        colors.Add(25, "Blue")
        colors.Add(58, "Yellow")
        ListBox1.Items.AddRange(Array.ConvertAll(colors.Values.ToArray, Function(s) s & " (0)"))
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        For y As Integer = 1 To 10000
            Dim x As Integer = r.Next(1, 1451)
            Dim listIndex As Integer
            '/7 = 1450
            '/10 = 1015
            '/25 = 406
            '/58 = 175

            Select Case x
                Case Is > 1015
                    listIndex = r.Next(0, 4)
                Case Is > 406
                    listIndex = r.Next(1, 4)
                Case Is > 175
                    listIndex = r.Next(2, 4)
                Case Is > 0
                    listIndex = 3
            End Select

            Dim rx As New Regex("(Red|Blue|Green|Yellow)\s\((\d+)\)")
            ListBox1.Items(listIndex) = Regex.Replace(ListBox1.Items(listIndex).ToString, rx.ToString, "$1 (" & (CInt(rx.Match(ListBox1.Items(listIndex).ToString).Groups(2).Value) + 1).ToString & ")")
        Next
    End Sub

End Class

---

Quote:

---

Originally Posted by dday9

What is done in role playing board/computer games is a dice is rolled to determine an outcome. JMcIlhinney has a code bank post here that is a Die(singular of dice) class. I would be tempted to use that.

---

How is that different to getting a random number from 1 to 100?

Quote:

---

here's my attempt at a solution:

---

:eek: Have you been at the Horlick's again?

Quote:

---

Originally Posted by dunfiddlin

How is that different to getting a random number from 1 to 100?

---

It's all the same, just a different spin on it. I personally prefer the rolling a die method, somebody else may prefer the method you presented.

ok. maybe there's a better solution.

Quote:

---

Originally Posted by dday9

It's all the same, just a different spin on it. I personally prefer the rolling a die method, somebody else may prefer the method you presented.

---

Maybe I am just being dense, but how does the roll of a die work in this case?

Quote:

---

Originally Posted by dbasnett

Maybe I am just being dense, but how does the roll of a die work in this case?

---

it doesn't strictly speaking. Those of us that can remember the heyday of board games that used actual boards will be familiar with percentage dice, two dice of differing colours numbered 0 - 9. You'd roll them and take the red one as tens, and the blue as units, for example, to get a number from 00 - 99.

Quote:

---

Originally Posted by dunfiddlin

:eek: Have you been at the Horlick's again?

---

I reckon you should post a proveable solution...

Isn't Horlick's a suspension rather than a solution?

Quote:

---

Originally Posted by dunfiddlin

it doesn't strictly speaking. Those of us that can remember the heyday of board games that used actual boards will be familiar with percentage dice, two dice of differing colours numbered 0 - 9. You'd roll them and take the red one as tens, and the blue as units, for example, to get a number from 00 - 99.

---

Ten sided die? What about the other colors the OP mentioned?

Yup 10 sided.

Attachment 100463

I've still got a couple of pairs knocking around somewhere. You could also get 12 and 20 sided though I never personally found a use for them.

Colours were an example. I have a list of 20+ items each assigned a percentage. Then a random is used to return one of those items based of the percentage and some % are below 1. Would be inefficient I think to use dice.

Code:

---

Dim greens() As Integer = Enumerable.Range(0, 7).Select(Function(i) 0).ToArray 'seven elements of one hundred assigned value 0
Dim reds() As Integer = Enumerable.Range(0, 10).Select(Function(i) 1).ToArray 'ten elements of one hundred assigned value 1
Dim blues() As Integer = Enumerable.Range(0, 25).Select(Function(i) 2).ToArray 'twenty five elements of one hundred assigned value 2
Dim yellows() As Integer = Enumerable.Range(0, 58).Select(Function(i) 3).ToArray 'fifty eight elements of one hundred assigned value 3

Dim possibles() As Integer = greens.Concat(reds).Concat(blues).Concat(yellows).ToArray 'join the four arrays

Dim x As Integer = r.Next(0, 100) 'pick a random number 0 to 99
Dim listIndex As Integer = possibles(x) 'listIndex will equal 0, 1, 2, or 3 with a 7% chance of 0, 10% chance of 1, 25% chance of 2, + 58% chance of 3

---

edit: to make it more random:

Code:

---

possibles = possibles.OrderBy(Function(i) r.NextDouble).ToArray

---

Quote:

---

Originally Posted by xx_dan_xx

Colours were an example. I have a list of 20+ items each assigned a percentage. Then a random is used to return one of those items based of the percentage and some % are below 1. Would be inefficient I think to use dice.

---

Do the percentages add up to 100%?

Quote:

---

Originally Posted by dbasnett

Do the percentages add up to 100%?

---

Yes they do. And ill take a look at that paul thanks.

Paul haven't had time to test it since I had exams yesterday and today but I'm not sure that would work for decimal percentages. For instance I have a percentage at 0.20%.

Here's a class that will do the job for you:

Code:

---

''' <summary>
''' Generates random values from a list with weighted likelihoods.
''' </summary>
''' <typeparam name="T">
''' The type of the items to be selected.
''' </typeparam>
Public Class WeightedRandom(Of T)

    ''' <summary>
    ''' The random number generator.
    ''' </summary>
    ''' <remarks>
    ''' There is one instance for all instances of the class.
    ''' </remarks>
    Private Shared rng As New Random

    ''' <summary>
    ''' Values keyed on the maximum weight for which they will be selected.
    ''' </summary>
    Private ReadOnly valuesByWeightThreshold As New Dictionary(Of Integer, T)

    ''' <summary>
    ''' The weights of all values summed.
    ''' </summary>
    Private ReadOnly totalWeight As Integer

    ''' <summary>
    ''' Initialises a new instance of the <see cref="WeightedRandom(Of T)"/> class.
    ''' </summary>
    ''' <param name="weightsByValue">
    ''' A list of values and the weights for each one.
    ''' </param>
    Public Sub New(weightsByValue As IDictionary(Of T, Integer))
        Dim rollingWeight As Integer

        For Each key In weightsByValue.Keys
            'Get the weight for all values up to and including this one.
            rollingWeight += weightsByValue(key)

            'Add the value against that summed weight.
            valuesByWeightThreshold.Add(rollingWeight, key)
        Next

        'Random numbers will be generated less than the total weight.
        totalWeight = rollingWeight
    End Sub

    ''' <summary>
    ''' Gets the next random value.
    ''' </summary>
    ''' <returns>
    ''' A value based on a weighted random selection
    ''' </returns>
    Public Function NextValue() As T
        'Generate a random number in the range specified by the combined weights.
        Dim number = rng.Next(totalWeight)
        Dim value As T

        'Find the first weight threshold that is greater than
        'the generated number and return the corresponding value.
        For Each weight In valuesByWeightThreshold.Keys
            If number < weight Then
                value = valuesByWeightThreshold(weight)
                Exit For
            End If
        Next

        Return value
    End Function

End Class

---

Using your colours and weights from post #1, here's a usage sample:

Code:

---

        Dim weightsByValue As New Dictionary(Of Color, Integer) From {{Color.Red, 10},
                                                                      {Color.Blue, 25},
                                                                      {Color.Green, 7},
                                                                      {Color.Yellow, 58}}
        Dim colourGenerator As New WeightedRandom(Of Color)(weightsByValue)
        Dim redCount As Integer
        Dim blueCount As Integer
        Dim greenCount As Integer
        Dim yellowCount As Integer

        For i = 1 To 100
            Select Case colourGenerator.NextValue()
                Case Color.Red
                    redCount += 1
                Case Color.Blue
                    blueCount += 1
                Case Color.Green
                    greenCount += 1
                Case Color.Yellow
                    yellowCount += 1
            End Select
        Next

        MessageBox.Show(String.Format("Reds:{1}{0}Blues:{2}{0}Greens:{3}{0}Yellows:{4}",
                                      Environment.NewLine,
                                      redCount,
                                      blueCount,
                                      greenCount,
                                      yellowCount))

---

Run that a few times and you'll see that the results are, as you would expect, around about the weights specified but not quite and they are a bit different each time.

That class has a few benefits:

1. You define the values and their weights once and then you don't have to think about them again.
2. You simply call a method and get back one of the values without having to worry about manipulating any numbers.
3. The same class can be used with objects of any type in a list of any length.
4. The weights don't have to add up to 100. They can be anything you like.

Just note that that constructor doesn't prevent zero or negative weights being used or total weights greater than Int32.MaxValue. I had to leave a bit of work for someone else.

Quote:

---

Originally Posted by .paul.

Code:

---

Dim greens() As Integer = Enumerable.Range(0, 7).Select(Function(i) 0).ToArray 'seven elements of one hundred assigned value 0
Dim reds() As Integer = Enumerable.Range(0, 10).Select(Function(i) 1).ToArray 'ten elements of one hundred assigned value 1
Dim blues() As Integer = Enumerable.Range(0, 25).Select(Function(i) 2).ToArray 'twenty five elements of one hundred assigned value 2
Dim yellows() As Integer = Enumerable.Range(0, 58).Select(Function(i) 3).ToArray 'fifty eight elements of one hundred assigned value 3

Dim possibles() As Integer = greens.Concat(reds).Concat(blues).Concat(yellows).ToArray 'join the four arrays

Dim x As Integer = r.Next(0, 100) 'pick a random number 0 to 99
Dim listIndex As Integer = possibles(x) 'listIndex will equal 0, 1, 2, or 3 with a 7% chance of 0, 10% chance of 1, 25% chance of 2, + 58% chance of 3

---

edit: to make it more random:

Code:

---

possibles = possibles.OrderBy(Function(i) r.NextDouble).ToArray

---

---

That works for whole numbers but I have decimal percentages. EG (0.25%, 14.3%, etc.) Is there another method than random to pick randomly.

Wasn't something like this suggested?

Code:

---

        Dim d As Double = prng.NextDouble()
        Select Case d
            Case Is <= 0.0025
            Case Is <= 0.01
            Case Is <= 0.143
            Case Is <= 0.25
            Case Is <= 0.58

        End Select

---

Also, jmc's (aka jim) code can probably be modified to use doubles instead of integers.

you just need to scale it up:

Code:

---

Dim greens() As Integer = Enumerable.Range(0, 730).Select(Function(i) 0).ToArray 'seven hundred + thirty elements of ten thousand (7.3%) assigned value 0
Dim reds() As Integer = Enumerable.Range(0, 1025).Select(Function(i) 1).ToArray 'one thousand + twenty five elements of ten thousand (10.25%) assigned value 1
Dim blues() As Integer = Enumerable.Range(0, 2545).Select(Function(i) 2).ToArray 'two thousand five hundred + forty five elements of ten thousand (25.45%) assigned value 2
Dim yellows() As Integer = Enumerable.Range(0, 5700).Select(Function(i) 3).ToArray 'five thousand seven hundred elements of ten thousand (57%) assigned value 3

Dim possibles() As Integer = greens.Concat(reds).Concat(blues).Concat(yellows).ToArray 'join the four arrays
possibles = possibles.OrderBy(Function(i) r.NextDouble).ToArray

Dim x As Integer = r.Next(0, 10000) 'pick a random number 0 to 9999
Dim listIndex As Integer = possibles(x) 'listIndex will equal 0, 1, 2, or 3 with a 7.3% chance of 0, 10.25% chance of 1, 25.45% chance of 2, + 57% chance of 3

---

I finally came up with my own solution using your guys ideas. It would support decimal percentages to huge decimal places, random and short.

Code:

---

Dim useRandom As New Random
        Select Case (Math.Round(useRandom.NextDouble(), 2))
            Case 0 To 0.25
                MsgBox("Red")
            Case 0.26 To 0.5
                MsgBox("Blue")
            Case 0.51 To 0.75
                MsgBox("Green")
            Case 0.76 To 1
                MsgBox("Yellow")
        End Select

---

Quote:

---

Originally Posted by xx_dan_xx

That works for whole numbers but I have decimal percentages. EG (0.25%, 14.3%, etc.) Is there another method than random to pick randomly.

---

You do realise that you can simply multiply those decimals by factors of 10 and they become whole numbers, right? If the largest number of decimal places is 2 then you simply multiple everything by 100 . You can then use .paul.'s suggestion or mine as is. That said, here's my WeightedRandom class adapted to use Doubles:

Code:

---

''' <summary>
''' Generates random values from a list with weighted likelihoods.
''' </summary>
''' <typeparam name="T">
''' The type of the items to be selected.
''' </typeparam>
Public Class WeightedRandom(Of T)

    ''' <summary>
    ''' The random number generator.
    ''' </summary>
    ''' <remarks>
    ''' There is one instance for all instances of the class.
    ''' </remarks>
    Private Shared rng As New Random

    ''' <summary>
    ''' Values keyed on the maximum weight for which they will be selected.
    ''' </summary>
    Private ReadOnly valuesByWeightThreshold As New Dictionary(Of Double, T)

    ''' <summary>
    ''' The weights of all values summed.
    ''' </summary>
    Private ReadOnly totalWeight As Double

    ''' <summary>
    ''' Initialises a new instance of the <see cref="WeightedRandom(Of T)"/> class.
    ''' </summary>
    ''' <param name="weightsByValue">
    ''' A list of values and the weights for each one.
    ''' </param>
    Public Sub New(weightsByValue As IDictionary(Of T, Double))
        Dim rollingWeight As Double

        For Each key In weightsByValue.Keys
            'Get the weight for all values up to and including this one.
            rollingWeight += weightsByValue(key)

            'Add the value against that summed weight.
            valuesByWeightThreshold.Add(rollingWeight, key)
        Next

        'Random numbers will be generated less than the total weight.
        totalWeight = rollingWeight
    End Sub

    ''' <summary>
    ''' Gets the next random value.
    ''' </summary>
    ''' <returns>
    ''' A value based on a weighted random selection
    ''' </returns>
    Public Function NextValue() As T
        'Generate a random number in the range specified by the combined weights.
        Dim number = rng.NextDouble() * totalWeight
        Dim value As T

        'Find the first weight threshold that is greater than
        'the generated number and return the corresponding value.
        For Each weight In valuesByWeightThreshold.Keys
            If number < weight Then
                value = valuesByWeightThreshold(weight)
                Exit For
            End If
        Next

        Return value
    End Function

End Class

---

The sample usage is exactly the same except that the Dictionary values are type Double instead of type Integer, e.g.

Code:

---

'Proportional weightings of 1:38:20:51.
Dim weightsByValue As New Dictionary(Of Color, Double) From {{Color.Red, 0.25},
                                                              {Color.Blue, 9.5},
                                                              {Color.Green, 5},
                                                              {Color.Yellow, 12.75}}
Dim colourGenerator As New WeightedRandom(Of Color)(weightsByValue)
Dim redCount As Integer
Dim blueCount As Integer
Dim greenCount As Integer
Dim yellowCount As Integer

For i = 1 To 100
    Select Case colourGenerator.NextValue()
        Case Color.Red
            redCount += 1
        Case Color.Blue
            blueCount += 1
        Case Color.Green
            greenCount += 1
        Case Color.Yellow
            yellowCount += 1
    End Select
Next

MessageBox.Show(String.Format("Reds:{1}{0}Blues:{2}{0}Greens:{3}{0}Yellows:{4}",
                              Environment.NewLine,
                              redCount,
                              blueCount,
                              greenCount,
                              yellowCount))
Sub

---

I found a different method, which isminimal and that would require more lines of code when I already have a solution which is small.

Quote:

---

Originally Posted by xx_dan_xx

I found a different method, which isminimal and that would require more lines of code when I already have a solution which is small.

---

You "found" a solution that just happens to be almost exactly what was suggested in post #2 nearly 24 hours ago. Anyway, I'm not saying that mine is the only or even the best solution but what it does do is create a reusable class so, once that exists, you have to write very little code to use it, plus it can be used to select values of any type. VB is an OO language for a reason so making use of that is rarely a bad thing.