I am new to VB. I am working on a project, Bingo of all games. I have been able to get the program to generate a random ball with shuffle method, so it has no duplicate balls. What I have not been able to do is fill the bingo card with no duplicates. This is standard bingo w/75 balls. B: 1to 15, I:16-30, N: 31-45, G: 46-60, O: 61-75. I have tried several different techniques however none so far have worked. I am able to get the card to fill with duplicates but that is not what I am trying to accomplish. I assume I need another Random number generator other than the one I used for drawing the bingo balls? Using Case and labels I am trying to sort the randomly generated numbers to fill the card when the New Game button is selected. My plan is to put the chosen numbers in an array so that I may search the array to determine if a player has achieved bingo. I have seen examples online but most use the old Rnd method and none so far that I have found do so without duplicates. Any help for this beginner would be greatly appreciated. I will attempt to attach my work in a zip file below but it may be too big to send so the code is also below.
Public Class BingoCard
Public b As New List(Of Integer)
Public i As New List(Of Integer)
Public n As New List(Of Integer)
Public g As New List(Of Integer)
Public o As New List(Of Integer)
Public Shared prng As New Random
Public Sub New()
Me.b.AddRange(Enumerable.Range(1, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.i.AddRange(Enumerable.Range(16, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.n.AddRange(Enumerable.Range(31, 15).OrderBy(Function(y) prng.Next()).Take(4))
Me.g.AddRange(Enumerable.Range(46, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.o.AddRange(Enumerable.Range(61, 15).OrderBy(Function(y) prng.Next()).Take(5))
End Sub
End Class
edit: I was bored
Code:
Public Class BingoGame
Private Shared prng As New Random
Private b As New List(Of Integer)
Private i As New List(Of Integer)
Private n As New List(Of Integer)
Private g As New List(Of Integer)
Private o As New List(Of Integer)
Private Cards As New List(Of BingoCard)
''' <summary>
''' at least one card has bingo
''' </summary>
''' <remarks></remarks>
Public CardHasBingo As Boolean = False
Private letters As String = "bingo"
Private remaining As Integer = 75
Public Sub New()
Me.b.AddRange(Enumerable.Range(1, 15).OrderBy(Function(y) prng.Next()))
Me.i.AddRange(Enumerable.Range(16, 15).OrderBy(Function(y) prng.Next()))
Me.n.AddRange(Enumerable.Range(31, 15).OrderBy(Function(y) prng.Next()))
Me.g.AddRange(Enumerable.Range(46, 15).OrderBy(Function(y) prng.Next()))
Me.o.AddRange(Enumerable.Range(61, 15).OrderBy(Function(y) prng.Next()))
End Sub
Public Sub AddCard()
Me.Cards.Add(New BingoCard)
End Sub
Public Function DrawBall() As BingoBall
'todo no balls left
If Me.remaining = 0 Then Throw New Exception
Dim rv As New BingoBall
Dim whCol As List(Of Integer)
Do
rv.letter = Me.letters.Substring(prng.Next(letters.Length), 1)
Select Case rv.letter
Case "b"
whCol = Me.b
Case "i"
whCol = Me.i
Case "n"
whCol = Me.n
Case "g"
whCol = Me.g
Case "o"
whCol = Me.o
End Select
If whCol.Count = 0 Then
Me.letters = Me.letters.Replace(rv.letter, "")
End If
Loop While whCol.Count = 0
Me.remaining -= 1
rv.number = whCol(0)
whCol.RemoveAt(0) 'remove ball that was drawn
'check cards
For Each card As BingoCard In Me.Cards
If card.CheckCard(rv) Then
Me.CardHasBingo = True
End If
Next
Return rv
End Function
Public Function CardsWithBingo() As List(Of BingoCard)
Dim rv As New List(Of BingoCard)
For Each card As BingoCard In Me.Cards
If card.bingo Then
rv.Add(card)
End If
Next
Return rv
End Function
Public Class BingoCard
Public b As New List(Of Integer)
Public i As New List(Of Integer)
Public n As New List(Of Integer)
Public g As New List(Of Integer)
Public o As New List(Of Integer)
Public bingo As Boolean = False
Private Shared idNUM As Integer = 1
Public id As Integer
Public Sub New()
Me.b.AddRange(Enumerable.Range(1, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.i.AddRange(Enumerable.Range(16, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.n.AddRange(Enumerable.Range(31, 15).OrderBy(Function(y) prng.Next()).Take(4))
Me.g.AddRange(Enumerable.Range(46, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.o.AddRange(Enumerable.Range(61, 15).OrderBy(Function(y) prng.Next()).Take(5))
Me.id = idNUM
idNUM += 1
End Sub
Public Function CheckCard(ball As BingoBall) As Boolean
Dim whCol As List(Of Integer)
Select Case ball.letter
Case "b"
whCol = Me.b
Case "i"
whCol = Me.i
Case "n"
whCol = Me.n
Case "g"
whCol = Me.g
Case "o"
whCol = Me.o
End Select
For z As Integer = 0 To whCol.Count - 1
If whCol(z) = ball.number Then
whCol(z) = -whCol(z) 'negate
Exit For
End If
Next
'bingo column check
Me.bingo = True
For Each z As Integer In whCol
If z > 0 Then
Me.bingo = False
End If
Next
If Not Me.bingo Then
'TODO complete bingo checks
'rows and diagonals
End If
Return Me.bingo
End Function
End Class
Public Class BingoBall
Property letter As String
Property number As Integer
Public Overrides Function ToString() As String
Return Me.letter & Me.number.ToString()
End Function
End Class
End Class
Last edited by dbasnett; Apr 30th, 2017 at 06:50 AM.
I need to get non repeating randoms in a two dimensional array or 5 individual arrays. Someone was nice enough to suggest an easy method beyond where I am currently at in learning VB so must stick with what I can work with. I need the numbers auto generated when the new game button is pressed. I am not sure how to get the numbers into the array or arrays as there is only one event on pressing the new game button so only one number is generated. The game is standard bingo.
You can store generated random numbers in an array, then continue generating randoms until that array doesn't contain the number, something like this
Code:
Dim f As New List(Of Integer) ' store generated random number
For x As Integer = 1 To 75
Do
scramble = rand.Next(1, 76)
Loop While f.Contains(scramble) ' generated before, so generate another one.
f.Add(scramble)
rarray(x) = scramble
Next x
' when come here rarray will not contain the same number twice.
The code you provided moved me down the road. I do want to thank you, it has been very helpful. I am finally able to get numbers up but I am getting repeated values and the values all seem to be below 9 for B. I need lists or arrays with no repeats B: 1-15, I: 16-30, N: 31-45, G:46-60, O: 61-75. Latest build is attached. To start the game you must hit New Game Button. It is very close but not quite there. Thanks to all who have helped.
The way 4x2y suggested is intuitive, but often ends up really slow. The problem is every time you add a number, it gets more and more likely you'll pick a "wrong" number before continuing. One time I wrote a Minesweeper game that used that algorithm, and it often took more than a minute to generate a board.
So, obviously, there's a better way. You might be surprised to find the best way is a shuffle algorithm. There's not a way to get the Random class to NOT return particular numbers, so the next-best thing to do is put all of your numbers in the array and randomly arrange it. There's a lot of ways that "work" to do this, the one-line LINQ statement someone gave you in another thread is one. But, obviously, as a student at this point you can't use it.
Often, if we learn the solution to a simple problem, we can apply it to a larger problem. Instead of showing you how to deal with a 2-dimensional array, I'm going to show you a 1-dimensional array. You ought to be able to expand the algorithm, or maybe even be clever and note a 5x5 array is conceptually 5 different 5-element arrays.
A good shuffling algorithm is one called Knuth-Fisher-Yates. It works by starting at the end of the array, then swapping that element with a random other element. Then it moves to the 2nd-to-last element and repeats, all the way down to the 2nd element. Here's a quick demo that shuffles the numbers 1-10:
Code:
Imports System
Public Module Module1
Private _rng As New Random()
Public Sub Main()
Dim items() As Integer = { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 }
For i As Integer = items.Length - 1 To 1 Step -1
Dim swapIndex = _rng.Next(i + 1)
Dim temp As Integer = items(i)
items(i) = items(swapIndex)
items(swapIndex) = temp
Next
For Each item in items
Console.WriteLine(item)
Next
End Sub
End Module
Here's some Q&A on that code:
Why does it start at the end? It's easy to ask the Random class for a number from 0 to a number. It's a tiny bit harder to ask the Random class for a number from something else to that number. So starting at the end means the code's a little easier to write.
Can't it decide not to swap a number, by swapping 9 with 9? Yes, that's valid. If you disqualify it, you aren't shuffling as well, because { 1, 2, 3, ... } can still sometimes be generated by a true random shuffle.
Why doesn't it go down to 0? When there's only one element left, we'd ask the Random class to generate a number from 0 to 0. Obviously there's only one possibility, so it's a waste of time to "shuffle" that element.
This answer is wrong. You should be using TableAdapter and Dictionaries instead.
Private Sub btnNewGame_Click(sender As Object, e As EventArgs) Handles btnNewGame.Click
' Note: All arrays indexes goes from 0 to 14
Dim bBoard() As Integer = ShffleNumbers(1, 15)
Dim iBoard() As Integer = ShffleNumbers(16, 30)
Dim nBoard() As Integer = ShffleNumbers(31, 45)
Dim gBoard() As Integer = ShffleNumbers(46, 60)
Dim oBoard() As Integer = ShffleNumbers(61, 75)
' Note: Set labels font smaller than 36 to poroperly display 2 digits number
lblB1.Text = CStr(bBoard(0))
lblB2.Text = CStr(bBoard(2))
lblB3.Text = CStr(bBoard(11))
lblB4.Text = CStr(bBoard(13))
lblB5.Text = CStr(bBoard(14))
lblI1.Text = CStr(iBoard(0))
lblI2.Text = CStr(iBoard(1))
lblI3.Text = CStr(iBoard(2))
lblI4.Text = CStr(iBoard(3))
lblI5.Text = CStr(iBoard(4))
' set rest labels
'
'
'
End Sub
Private Function ShffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer()
Dim iRet As New List(Of Integer)
Dim Rand As New Random()
Dim r As Integer
For j As Integer = 1 To 15
Do
r = Rand.Next(intMin, intMax + 1)
Loop While iRet.Contains(r)
iRet.Add(r)
Next
Return iRet.ToArray
End Function
The following ShffleNumbers is better because it's auto calculate array length from intMin and intMax parameters
Code:
Private Function ShffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer()
Dim iRet As New List(Of Integer)
Dim Rand As New Random()
Dim r As Integer
For j As Integer = 0 To (intMax - intMin)
Do
r = Rand.Next(intMin, intMax + 1)
Loop While iRet.Contains(r)
iRet.Add(r)
Next
Return iRet.ToArray
End Function
Let's make a small modification and discuss "better":
Code:
Private Function ShffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer()
Dim totalLoops As Integer = 0
Dim iRet As New List(Of Integer)
Dim Rand As New Random()
Dim r As Integer
For j As Integer = 0 To (intMax - intMin)
Do
r = Rand.Next(intMin, intMax + 1)
totalLoops += 1
Loop While iRet.Contains(r)
iRet.Add(r)
Next
Console.WriteLine(totalLoops)
Return iRet.ToArray
End Function
If I call ShffleNumbers(0, 10), how big do you expect totalLoops to be? 10? 15? I got interested in this so I modified it again:
Code:
Public Sub Main()
Dim iterations As Integer = 1000
Dim sum As Long = 0
For i As Integer = 1 to iterations
sum += ShffleNumbers(0, 10)
Next
Dim average as Double = sum / iterations
Console.WriteLine("Average loops over {0} iterations: {1}", iterations, average)
End Sub
Private Function ShffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer
Dim totalLoops As Integer = 0
Dim iRet As New List(Of Integer)
Dim Rand As New Random()
Dim r As Integer
For j As Integer = 0 To (intMax - intMin)
Do
r = Rand.Next(intMin, intMax + 1)
totalLoops += 1
Loop While iRet.Contains(r)
iRet.Add(r)
Next
Return totalLoops
End Function
For 0-10, it averages about 22 loops. What about 0-100? I usually see results from 400-450 loops. 0-1000? Don't try it in .NET Fiddle, because it exceeds the maximum execution time. If you wait long enough, you find it takes, on average, 7,000+ loops to execute this shuffle for a list with 1000 items. I think you see the pattern. I wanted to do 0-10000, but it took longer than 5 minutes to finish.
The problem is apparent when you look at probability. Let's go back to (0, 10). On the first time around, there's a 100% chance you get a "good" number. The second time, only 9 available numbers are valid, so you have a 10% chance of trying again. By the 5th iteration, you're 50% likely to need to try again at least once. By the end, there's a 90% chance the "wrong" number is picked. That's cumulative. If you're looking for 5, nothing's stopping the RNG from spitting out "8, 4, 3, 7, 3, 2, 1, 0..." etc. When you get up to big sets like 0-1000, you have a > 90% chance of failure for the last 100 numbers!
That's why I explained the problem and suggested a true shuffle algorithm. It doesn't have that kind of scaling problem.
Code:
Public Sub Main()
Dim iterations As Integer = 1000
Dim sum As Long = 0
For i As Integer = 1 To iterations
sum += ShuffleNumbers(0, 10)
Next
Dim average As Double = sum / iterations
Console.WriteLine("Average loops over {0} iterations: {1}", iterations, average)
End Sub
Private Function ShuffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer
Dim totalLoops As Integer = 0
Dim rng As New Random()
Dim items() As Integer = Enumerable.Range(intMin, intMax - intMin + 1).ToArray()
For i As Integer = items.Length - 1 To 1 Step -1
Dim swapIndex = rng.Next(i)
Dim temp = items(i)
items(i) = items(swapIndex)
items(swapIndex) = temp
totalLoops += 1
Next
Return totalLoops
End Function
This always finishes in 10 loops for (0, 10). For (0, 100), it always finishes in 100 loops. For (0, 1000) it always finishes in 1,000 loops, and so on. This is because it only ever makes one pass over the array.
For small amounts of numbers like a Bingo card, your method isn't so wasteful as to introduce problems. But the approach very quickly gets out of hand. It's better to learn the way that works at scale.
This answer is wrong. You should be using TableAdapter and Dictionaries instead.
The way 4x2y suggested is intuitive, but often ends up really slow. The problem is every time you add a number, it gets more and more likely you'll pick a "wrong" number before continuing. One time I wrote a Minesweeper game that used that algorithm, and it often took more than a minute to generate a board.
I agree but ONLY if the array length is very very large, here we are dealing with array of only 15 items.
Above latest function ShffleNumbers takes less than 20 milliseconds to return shuffled array contains 1000 items, less than 3 seconds to return shuffled array contains 10,000 items, although it is running on an old PC with Pentium Dual-Core CPU
For small amounts of numbers like a Bingo card, your method isn't so wasteful as to introduce problems. But the approach very quickly gets out of hand. It's better to learn the way that works at scale.
I was looking at it from the standpoint of what it looks like to the player and the fact that I have 5 small arrays to search. The player has to know the number has been selected so changing the color would be similar to what they do when they get a number stamp the card. Since there is only three ways to win this game is it not going to be easier to search by color than to find indexes that have matched the chosen ball by creating yet another array? 4x2y thank you for the help I am learning new things every day I do this.
Finally, it is better to use Sitten Spynne's true shuffle algorithm.
This one shuffle an array contains sequential numbers range between intMin and intMax inclusive
Code:
Private Function ShuffleNumbers(ByVal intMin As Integer, ByVal intMax As Integer) As Integer()
Dim rng As New Random()
Dim swapIndex As Integer
Dim temp As Integer
Dim items() As Integer = Enumerable.Range(intMin, intMax - intMin + 1).ToArray()
For i As Integer = items.Length - 1 To 1 Step -1
swapIndex = rng.Next(i)
temp = items(i)
items(i) = items(swapIndex)
items(swapIndex) = temp
Next
Return items
End Function
Usage
Code:
Dim items() As Integer = ShuffleNumbers(1, 99)
This one shuffle an array contains not sequential numbers.
Code:
Private Function ShuffleNumbers(ByVal items() As Integer) As Integer()
Dim rng As New Random()
Dim swapIndex As Integer
Dim temp As Integer
For i As Integer = items.Length - 1 To 1 Step -1
swapIndex = rng.Next(i)
temp = items(i)
items(i) = items(swapIndex)
items(swapIndex) = temp
Next
Return items
End Function
Usage
Code:
Dim items() As Integer = ShuffleNumbers({10, 20, 30, 40, 50, 100, 200, 300, 400, 500})