Results 1 to 15 of 15

Thread: Random Generator with case

  1. #1

    Thread Starter
    New Member
    Join Date
    Mar 2017
    Posts
    10

    Random Generator with case

    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.
    Attached Files Attached Files

  2. #2
    Powered By Medtronic dbasnett's Avatar
    Join Date
    Dec 2007
    Location
    Jefferson City, MO
    Posts
    9,748

    Re: Random Generator with case

    Here is a simple bingo card generator.

    Code:
        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.
    My First Computer -- Documentation Link (RT?M) -- Using the Debugger -- Prime Number Sieve
    Counting Bits -- Subnet Calculator -- UI Guidelines -- >> SerialPort Answer <<

    "Those who use Application.DoEvents have no idea what it does and those who know what it does never use it." John Wein

  3. #3

    Thread Starter
    New Member
    Join Date
    Mar 2017
    Posts
    10

    Non repeating randoms in a arrays

    Hello

    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.
    Attached Files Attached Files

  4. #4
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Non repeating randoms in a arrays

    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.
    Last edited by 4x2y; Apr 30th, 2017 at 06:38 PM.



  5. #5

    Thread Starter
    New Member
    Join Date
    Mar 2017
    Posts
    10

    Non repeating random almost

    Hello,

    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.
    Attached Files Attached Files

  6. #6
    Powered By Medtronic dbasnett's Avatar
    Join Date
    Dec 2007
    Location
    Jefferson City, MO
    Posts
    9,748

    Re: Non repeating random almost

    This is the third question in a row about the same topic. Instead of starting new questions use the reply on existing questions please.
    My First Computer -- Documentation Link (RT?M) -- Using the Debugger -- Prime Number Sieve
    Counting Bits -- Subnet Calculator -- UI Guidelines -- >> SerialPort Answer <<

    "Those who use Application.DoEvents have no idea what it does and those who know what it does never use it." John Wein

  7. #7
    You don't want to know.
    Join Date
    Aug 2010
    Posts
    4,578

    Re: Non repeating randoms in a arrays

    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.

  8. #8
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002
    Location
    Idaho
    Posts
    38,943

    Re: Random Generator with case

    The three threads have been merged into one, since it is all posts about the same question.
    My usual boring signature: Nothing

  9. #9
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Random Generator with case

    Try this to fill labels with unique random number
    Code:
        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



  10. #10
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Random Generator with case

    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



  11. #11
    You don't want to know.
    Join Date
    Aug 2010
    Posts
    4,578

    Re: Random Generator with case

    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.

  12. #12
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Non repeating randoms in a arrays

    Quote Originally Posted by Sitten Spynne View Post
    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



  13. #13
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Random Generator with case

    Quote Originally Posted by Sitten Spynne View Post
    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.
    Now fully agree after your wonderful explanation



  14. #14

    Thread Starter
    New Member
    Join Date
    Mar 2017
    Posts
    10

    Re: Random Generator with case

    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.

  15. #15
    PowerPoster
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    2,579

    Re: Random Generator with case

    Please mark this thread as [RESOLVED]

    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})
    Last edited by 4x2y; May 4th, 2017 at 05:59 PM.



Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width