I am trying to make a Deal or no Deal game, however my problem at the moment is assigning set values to cases randomly. I have had no luck with randomly generating a number and checking if it already exists, so I am now attempting to simply shuffle the array. The problem is, for some reason, values get duplicated.
The code:
Dim nCaseValues(26) As Integer 'The different possible values for a case
Dim nCaseNumbers(26) As Integer 'The different case numbers
Dim nShadowNumber As Integer 'This holds the first number in the shuffle
Dim nShuffleNumber1 As Integer 'The first random position
Dim nShuffleNumber2 As Integer 'The second random position
'Clear the list if it already has content
listArray1.Items.Clear()
listArray2.Items.Clear()
listArray3.Items.Clear()
'Declare array for case values
nCaseValues(0) = 1500
nCaseValues(1) = 1
nCaseValues(2) = 2
nCaseValues(3) = 5
nCaseValues(4) = 10
nCaseValues(5) = 20
nCaseValues(6) = 50
nCaseValues(7) = 100
nCaseValues(8) = 150
nCaseValues(9) = 200
nCaseValues(10) = 250
nCaseValues(11) = 500
nCaseValues(12) = 750
nCaseValues(13) = 1000
nCaseValues(14) = 2000
nCaseValues(15) = 3000
nCaseValues(16) = 4000
nCaseValues(17) = 5000
nCaseValues(18) = 10000
nCaseValues(19) = 15000
nCaseValues(20) = 20000
nCaseValues(21) = 30000
nCaseValues(22) = 50000
nCaseValues(23) = 75000
nCaseValues(24) = 100000
nCaseValues(25) = 200000
'Declare array for case numbers
For genCaseNumArray = 0 To 25
nCaseNumbers(genCaseNumArray) = 0
listArray1.Items.Add(genCaseNumArray)
Next
'The shuffle
For J = 0 To 25 'This assigns case values to case numbers (It's probably moot, as I can just use the nCaseValues position, but it's here for now)
nCaseNumbers(J) = nCaseValues(J)
Next
For K = 0 To 25 'Lists the items below, this could possibly be an error
For I = 0 To 50 'Shuffles the list 50 times
nShuffleNumber1 = (Int(Rnd() * 26)) 'Gets a random number and assigns it
nShuffleNumber2 = (Int(Rnd() * 26))'Gets a random number and assigns it
nShadowNumber = nCaseNumbers(nShuffleNumber1) 'This holds the first value during the shuffle
nCaseNumbers(nShuffleNumber1) = nCaseNumbers(nShuffleNumber2)'First value now equals second value...
nCaseNumbers(nShuffleNumber2) = nShadowNumber 'And now second value holds first value.
Next 'Lists items in lists objects on the form
listArray1.Items.Add(K)
listArray2.Items.Add(nCaseValues(K))
listArray3.Items.Add(nCaseNumbers(K))
Next
I need each value to be unique. I am pretty sure it is a logic error in my code. Any help on why the numbers are duplicating would be great.
Here are a couple of outputs:
The first list is the Case Number, second is possible values in order, third is the final outcome - The individual case value. As you can see, some are duplicated, and the first list is repeated twice..
EDIT: I found out why it repeated twice - I was stupid enough to leave another for loop that was also adding to the list. I have solved my problem, see the answer below.
I figured out the problem (well, more just luck) - the internal For loop shouldn't of been internal. I moved it out, and voila - it works like a charm. So far. Let's just wait.
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Randomize() 'Make the form random
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
'State Variables
Dim nCaseValues(26) As Integer 'The different possible values for a case
Dim nShadowNumber As Integer
Dim nShuffleNumber1 As Integer
Dim nShuffleNumber2 As Integer
'Clear the list if it already has content
listArray1.Items.Clear()
listArray2.Items.Clear()
listArray3.Items.Clear()
'Declare array for case values
nCaseValues(0) = 1500 'If you're wondering why this is here, it's because I couldn't be bothered to work with a "car" value.
nCaseValues(1) = 1
nCaseValues(2) = 2
nCaseValues(3) = 5
nCaseValues(4) = 10
nCaseValues(5) = 20
nCaseValues(6) = 50
nCaseValues(7) = 100
nCaseValues(8) = 150
nCaseValues(9) = 200
nCaseValues(10) = 250
nCaseValues(11) = 500
nCaseValues(12) = 750
nCaseValues(13) = 1000
nCaseValues(14) = 2000
nCaseValues(15) = 3000
nCaseValues(16) = 4000
nCaseValues(17) = 5000
nCaseValues(18) = 10000
nCaseValues(19) = 15000
nCaseValues(20) = 20000
nCaseValues(21) = 30000
nCaseValues(22) = 50000
nCaseValues(23) = 75000
nCaseValues(24) = 100000
nCaseValues(25) = 200000
'Declare array for case numbers, probably obsolete
For genCaseNumArray = 0 To 25
nCaseNumbers(genCaseNumArray) = 0
Next
For J = 0 To 25 'Assigning case values to case numbers
nCaseNumbers(J) = nCaseValues(J)
Next
For I = 0 To 26 'The main shuffle.
nShuffleNumber1 = (Int(Rnd() * 26)) 'This selects a random number between 0 and 25, somehow.
nShuffleNumber2 = (Int(Rnd() * 26)) 'Ditto
nShadowNumber = nCaseNumbers(nShuffleNumber1) 'This "Shadow Number" will be used to temporarily hold the value of the first case
nCaseNumbers(nShuffleNumber1) = nCaseNumbers(nShuffleNumber2) 'The value of the first case now equals the value of the second case...
nCaseNumbers(nShuffleNumber2) = nShadowNumber '... and vice versa.
Next 'Display the cases, case values and shuffled case values in the lists.
For K = 0 To 25
listArray1.Items.Add(K)
listArray2.Items.Add(nCaseValues(K))
listArray3.Items.Add(nCaseNumbers(K))
Next
I found this to be a really simple and (maybe) efficient way of shuffling an array. A lot easier than writing a script for a MERN.
I used to recommend randomising an array like this:
Dim rng As New Random
myArray = myArray.OrderBy(Function(element) rng.NextDouble()).ToArray()
It has since been pointed out to me that there is a serious issue with that because it will generate a new random number for the same element multiple times and thus comparing the same two elements could produce different results on different occasions. There's also the lesser issue that it creates a new array object. The following overcomes both those issues:
Dim rng As New Random
Dim keys = myArray.Select(Function(element) rng.NextDouble()).ToArray()
Array.Sort(keys, myArray)
That generates one random number per element and then sorts the original array in-place by those keys.
Related
I am not familiar with using macro's, but I think that what I would like excel to perform is best handled with a macro. So I can use all the input you may have!
I have these headers;
ID Tag Pen Sex Weight Class Inside range
With 450 rows of data. Based on the distribution of the weight data, I have in two other columns (class and number) the number of rows I want to select within each class. The selected rows must have the value "Yes" in the column "Inside range".
I want to randomly select the rows, based on the number needed for each class, and copy these rows to a new sheet. It sums up to 30 rows in the new sheet.
I hope you have a suggestion how to complete this action!
can you try the following, you will need to add a reference to Microsoft Scripting Runtime library:
Const rowCount = 450
Public Sub copyRows()
Dim i As Integer
Dim j As Integer
Dim classes As Scripting.Dictionary
Dim source As Worksheet
Dim colNumber As Integer
Dim colClassName as Integer
Dim colInsideRange As Integer
Dim allSelected As Boolean
Dim randomRow as Integer
Dim sumRemaining as Integer
allSelected = False
Set source = Worksheets("YourWorksheetName")
colClassName = 6 'this is the column number where class names are entered. I am assuming 6
colNumber = 7 'this is the column number where number of rows to be selected are entered. I am assuming 7
colInsideRange = 8 'this is the column number where "Inside Range" values are entered. I am assuming 9
For i = 2 to rowCount + 1 'assuming you have a header row
classes(CStr(source.Cells(i, colClassName))) = CInt(source.cells(i, colNumber)
Next i
Do until allSelected
Randomize
randomRow = Int ((Rnd * 450) + 2) 'assuming you have a header row, + 1 if you don't
If classes(CStr(source.Cells(randomRow, colClassName))) = 0 Then
With classes
sumRemaining = 0
For j = 1 to .Count - 1
sumRemaining = sumRemaining + .Items(j)
If sumRemaining > 0 Then Exit For
Next j
allSelected = (sumRemaining = 0)
End With
Else
source.Cells(randomRow, colInsideRange) = "Yes"
classes(CStr(source.Cells(randomRow, colClassName))) = classes(CStr(source.Cells(randomRow, colClassName))) - 1
End If
Loop
'Enter your code to copy rows with "Inside Range" = "Yes"
End Sub
Sorry if there are some errors or typos, I wrote from my mobile phone.
I'm making a 'Deal or No Deal' type game for a project in Visual Basic 2008.
I'm having a problem assigning the 5 values randomly to 5 boxes.
For example, in one game, the boxes could hold these values:
Box 1 = 1000
Box 2 = 35000
Box 3 = 25000
Box 4 = 75000
Box 5 = 5000
and in another game, they could hold these values
Box 1 = 75000
Box 2 = 25000
Box 3 = 1000
Box 4 = 5000
Box 5 = 35000
The main aim is to randomly assign these values to each box, and once a value has been assigned, it cannot be assigned to another box at the same time.
Here is the code that I have at the moment:
Dim values As New List(Of Integer)
Dim box(4) As Integer
Dim randNum(4) As Integer
'adding values to the Value list
values.Add(1000)
values.Add(5000)
values.Add(25000)
values.Add(35000)
values.Add(75000)
Dim i As Integer
For i = 0 To 4
Dim RandomClass As New Random()
Dim RandomNumber As Integer
RandomNumber = RandomClass.Next(0, 4)
'assigning a box a random value form the list
box(i) = values(RandomNumber)
'removing that value from the list
values.RemoveAt(i)
Next
Console.WriteLine("Box 1 = " & box(0))
Console.WriteLine("Box 2 = " & box(1))
Console.WriteLine("Box 3 = " & box(2))
Console.WriteLine("Box 4 = " & box(3))
Console.WriteLine("Box 5 = " & box(4))
Console.Read()
VB keeps returning this error message when I try t run the application:
Index was out of range. Must be non-negative and less than the size of the collection. Parameter name: index
Thanks in advance for any answers.
When you remove an item, the length of the list gets smaller. So on the second loop, index of 4 no longer exists. On the third loop, 3 no longer exists and so on. Try this instead:
Dim RandomClass As New Random()
Dim RandomNumber As Integer
For i = 0 To 4
RandomNumber = RandomClass.Next(0, values.count - 1)
'assigning a box a random value form the list
box(i) = values(RandomNumber)
'removing that value from the list
values.RemoveAt(i)
Next
The answer from Steve prevents the error from occurring, but I think it's still not doing quite what you want. values.RemoveAt(i) will always remove the first item from the list the first time, the second, next time, etc... it is not removing the value that you have just put in the box. To do that you should use values.RemoveAt(RandomNumber) instead.
For i = 0 To 4
RandomNumber = RandomClass.Next(0, values.count - 1)
'assigning a box a random value form the list
box(i) = values(RandomNumber)
'removing that value from the list
values.RemoveAt(RandomNumber)
Next
I'm trying to randomize an array from numbers 0 to 51 using loops but I just cannot seem to pull it off. My idea was that
Generate a Random Number
Check if this random number has been used by storing the previous in an array
If this random number has been used, generate new random number until it is not a duplicate
If it's not a duplicate, store it
My attempt:
Dim list(51) As Integer
Dim templist(51) As Integer
For i As Integer = 0 To 51 Step 1
list(i) = i
Next i
Do While counter <= 51
p = rand.Next(0, 52)
templist(counter) = p
For n As Integer = 0 To 51 Step 1
p = rand.Next(0, 52)
If templist(n) = p Then
Do While templist(n) = p
p = rand.Next(0, 52)
Loop
templist(n) = p
Else
templist(n) = p
End If
Next
counter += 1
Loop
For n As Integer = 0 To 51 Step 1
ListBox1.Items.Add(templist(n))
Next
It will be a lot easier if you just have a list of all of the possible numbers (0 to 51 in your case), then remove the number from the list so it can't be picked again. Try something like this:
Dim allNumbers As New List (Of Integer)
Dim randomNumbers As New List (Of Integer)
Dim rand as New Random
' Fill the list of all numbers
For i As Integer = 0 To 51 Step 1
allNumbers.Add(i)
Next i
' Grab a random entry from the list of all numbers
For i As Integer = 0 To 51 Step 1
Dim selectedIndex as Integer = rand.Next(0, (allNumbers.Count - 1) )
Dim selectedNumber as Integer = allNumbers(selectedIndex)
randomNumbers.Add(selectedNumber)
allNumbers.Remove(selectedNumber)
' Might as well just add the number to ListBox1 here, too
ListBox1.Items.Add(selectedNumber)
Next i
If your goal is to get the numbers into ListBox1, then you don't even need the "randomNumbers" list.
EDIT:
If you must have an array, try something like this:
Function RandomArray(min As Integer, max As Integer) As Integer()
If min >= max Then
Throw New Exception("Min. must be less than Max.)")
End If
Dim count As Integer = (max - min)
Dim randomNumbers(count) As Integer
Dim rand As New Random()
' Since an array of integers sets every number to zero, and zero is possibly within our min/max range (0-51 here),
' we have to initialize every number in the array to something that is outside our min/max range.
If min <= 0 AndAlso max >= 0 Then
For i As Integer = 0 To count
randomNumbers(i) = (min - 1) ' Could also be max + 1
Next i
End If
Dim counter As Integer = 0
' Loop until the array has count # of elements (so counter will be equal to count + 1, since it is incremented AFTER we place a number in the array)
Do Until counter = count + 1
Dim someNumber As Integer = rand.Next(min, max + 1)
' Only add the number if it is not already in the array
If Not randomNumbers.Contains(someNumber) Then
randomNumbers(counter) = someNumber
counter += 1
End If
Loop
Return randomNumbers
End Function
This is good enough for your assignment, but the computer scientist in my hates this algorithm.
Here's why this algorithm is much less desirable. If zero is in your range of numbers, you will have to loop through the array at least 2N times (so 104+ times if you are going from 0 to 51). This is a best case scenario; the time complexity of this algorithm actually gets worse as the range of numbers scales higher. If you try running it from 0 to 100,000 for example, it will fill the first few thousand numbers very quickly, but as it goes on, it will take longer and longer to find a number that isn't already in the list. By the time you get to the last few numbers, you could potentially have randomly generated a few trillion different numbers before you find those last few numbers. If you assume an average complexity of 100000! (100,000 factorial), then the loop is going to execute almost ten to the half-a-millionth power times.
An array is more difficult to "shuffle" because it is a fixed size, so you can't really add and remove items like you can with a list or collection. What you CAN do, though, is fill the array with your numbers in order, then go through a random number of iterations where you randomly swap the positions of two numbers.
Do While counter <= 51
p = rand.Next(0, 52)
While Array.IndexOf(list, p) = -1
p = rand.Next(0, 52)
End While
counter += 1
Loop
Haven't written VB in about 5 years, but try this out:
Function GetRandomUniqueNumbersList(ByVal fromNumber As Integer, ByVal toNumber As Integer) As List(Of Integer)
If (toNumber <= fromNumber) Then
Throw New ArgumentException("toNumber must be greater than fromNumber", toNumber)
End If
Dim random As New Random
Dim randomNumbers As New HashSet(Of Integer)()
Do
randomNumbers.Add(random.Next(fromNumber, toNumber))
Loop While (randomNumbers.Count < toNumber - fromNumber)
Return randomNumbers.ToList()
End Function
Ok, that was painful. Please someone correct it if I made any mistakes. Should be very quick because it's using a HashSet.
First response to forum on stackoverflow - be gentle.
I was looking for a way to do this but couldn't find a suitable example online.
I've had a go myself and eventually got this to work:
Sub addUnique(ByRef tempList, ByVal n, ByRef s)
Dim rand = CInt(Rnd() * 15) + 1
For j = 0 To n
If tempList(j) = rand Then
s = True
End If
Next
If s = False Then
tempList(n) = rand
Else
s = False
addUnique(tempList, n, s)
End If
End Sub
Then call the sub using:
Dim values(15) As Byte
Dim valueSeen As Boolean = False
For i = 0 To 15
addUnique(values, i, valueSeen)
Next
This will randomly add the numbers 1 to 16 into an array. Each time a value is added, the previous values in the array are checked and if any of them are the same as the randomly generated value, s is set to true. If a value is not found (s=false), then the randomly generated value is added. The sub is recursively called again if s is still true at the end of the 'For' loop. Probably need 'Randomize()' in there somewhere.
Apologies if layout is a bit wobbly.
This code generates a stack overflow. I'm aware it is caused by the procedure calling itself.
What can I do to avoid the stack overflow? Recalling the sub procedure and generating a new random number is the easiest thing to do, however it generates the overflow. The randomly generated number picks a random inventory item, then the if statement matches that number (random inventory item) with the quantity of that item from the deck inventory to make sure it isn't less than 1. If the inventory of that item is 0, the else plays and restarts the procedure, generating a new random number and doing the process all over again. In another procedure I have a function that if the deck's inventory becomes completely empty, then the discard pile replenishes the deck, making the discard pile empty, so there should never be a case where all randomly generated numbers can be associated item with a inventory of 0.
I wonder if I could somehow force the random number generator
Number = (DeckGroup(Rnd.Next(0, DeckGroup.Count)).ID)
not to generate numbers to inventory items DeckGroup(Number).QuantityInteger that are zero. By doing so I wouldn't even need to recall the function.
The random number is generated by a different branch in the same structure group.
Private Sub PlayElse()
Dim CardCheckBoxArray() As CheckBox = {CardCheckBox1, CardCheckBox2, CardCheckBox3, CardCheckBox4, CardCheckBox5}
'Reset Number Generator
Number = (DeckGroup(Rnd.Next(0, DeckGroup.Count)).ID)
Dim PlayerQuantitySubtractionInteger As Integer
For PlayerQuantitySubtractionInteger = ChecksDynamicA To ChecksDynamicB
If CardCheckBoxArray(TextBoxInteger).Checked = True And DeckGroup(Number).QuantityInteger > 0 Then
DeckGroup(Number).QuantityInteger -= 1
'Select the Player depending value of T
Select Case T
Case 0
Player1HandGroup(Number).QuantityInteger += 1
Case 1
Player1HandGroup(Number).QuantityInteger2 += 1
Case 2
Player1HandGroup(Number).QuantityInteger3 += 1
Case 3
Player1HandGroup(Number).QuantityInteger4 += 1
Case 4
Player1HandGroup(Number).QuantityInteger5 += 1
End Select
CardTypeArray(PlayerQuantitySubtractionInteger) = Player1HandGroup(Number).CardType
CardCheckBoxArray(TextBoxInteger).Text = Player1HandGroup(Number).CardNameString
NumberArray(PlayerQuantitySubtractionInteger) = Number
Else
If CardCheckBoxArray(TextBoxInteger).Checked = True And DeckGroup(Number).QuantityInteger < 0 Then
Call PlayElse()
End If
End If
Next PlayerQuantitySubtractionInteger
End Sub
You could use LINQ to weed out all the objects you never want to get first and then use the collection returned by the linq instead of your original collection.
Something like:
Private Sub PlayElse()
Dim CardCheckBoxArray() As CheckBox = {CardCheckBox1, CardCheckBox2, CardCheckBox3, CardCheckBox4, CardCheckBox5}
'Reset Number Generator
Dim temp As IEnumerable(Of LunchMoneyGame.LunchMoneyMainForm.Group) = From r In DeckGroup Where r.QuantityInteger > 0 Select r
If temp IsNot Nothing AndAlso temp.Any Then
Number = (temp(Rnd.Next(0, temp.Count)).ID)
' ** Edit **: This will ensure that you only got 1 object back from the LINQ which can tell you whether or not you have bad data. You *can* exclude this check but its good practice to include it.
Dim obj As LunchMoneyGame.LunchMoneyMainForm.Group = Nothing
Dim t = From r In temp Where r.ID = Number Select r
If t IsNot Nothing AndAlso t.Count = 1 Then
obj = t(0)
End If
If obj IsNot Nothing Then
Dim PlayerQuantitySubtractionInteger As Integer
For PlayerQuantitySubtractionInteger = ChecksDynamicA To ChecksDynamicB
' ** Edit **
obj.QuantityInteger -= 1
'Select the Player depending value of T
Select Case T
Case 0
Player1HandGroup(Number).QuantityInteger += 1
Case 1
Player1HandGroup(Number).QuantityInteger2 += 1
Case 2
Player1HandGroup(Number).QuantityInteger3 += 1
Case 3
Player1HandGroup(Number).QuantityInteger4 += 1
Case 4
Player1HandGroup(Number).QuantityInteger5 += 1
End Select
CardTypeArray(PlayerQuantitySubtractionInteger) = Player1HandGroup(Number).CardType
CardCheckBoxArray(TextBoxInteger).Text = Player1HandGroup(Number).CardNameString
NumberArray(PlayerQuantitySubtractionInteger) = Number
Next PlayerQuantitySubtractionInteger
End If
End If
End Sub
Pass through the list and determine only those that are valid. Then randomly pull from that set. Here is a simple version of it. You could use LINQ as well, but this should be clear enough:
Dim validDeckGroupsIndexes As New List(Of Integer)
For ndx As Integer = 0 to DeckGroup.Count - 1
If DeckGroup(ndx).QuantityInteger > 0 Then
validDeckGroupsIndexes .Add(ndx)
End If
Next ndx
Then use this:
Dim deckGroupNdx As Integer = Rnd.Next(0, validDeckGroupsIndexes.Count)
Number = DeckGroup(deckGroupNdx).ID
In this datatable there are no duplicates, I need the row index where column x value equals 2. I would do it like this:
Dim rowIndex As Integer = 0
For i = 0 To mtable.Rows.Count - 1
If mtable.Rows(i)("x") = 2 Then
rowIndex = i
Exit For
End If
Next
I will be calling this process multiple times per second. Is there a faster way to do this in .NET?
DataTable select could work, i think it should be faster than iterating over the collection of rows.
var index = mtable.Rows.IndexOf(mtable.Select("x = 2").FirstOrDefault());
Multiple times per second is a bit vague - tens or thousands?
You could create a hash table mapping the value of "x" to the row number:
Dim nLookups = mtable.Rows.Count - 1
Dim lookupHash As New Hashtable(nLookups)
For i = 0 To nLookups
lookupHash.Add(CInt(mtable.Rows(i)("x")), i)
Next
then
Dim rowSought As Integer = -1
If lookupHash.ContainsKey(2) Then
rowSought = lookupHash(2)
End If
Or if the range of possible values of "x" is suitable, you could use an array to map the value to the row number.