Results 1 to 12 of 12

Thread: Random Number, no duplicates

  1. #1

    Thread Starter
    New Member
    Join Date
    Mar 2017
    Posts
    3

    Random Number, no duplicates

    I've been searching and trying for a while before posting this. Basically I'm making a quiz, and using rand(1, max_questions) and, as expected, it gives multiples of the same questions. My first thought was an array to store the used questions but failed at doing that. I thought storing used questions and checking if the question number had been used previously, if so select a new number would work. But this would end up looping and pausing the server way too much.

    Can anyone point in in the right direction?

    Code:
    If EventQuizTime = True Then
            If Minute(Now) >= QuizStartTime And Minute(Now) < QuizEndTime Then
                If OnlinePlayers(0) > 0 Then
                    v = rand(1, MAX_QUESTIONS)
                    CurrentQuestion = v
                    i = 0
                    Do While i <= UBound(OnlinePlayers)
                            PlayerIndex = OnlinePlayers(i)
                            TempPlayer(PlayerIndex).Answer = 0
                            
                                Call SendQuestion(PlayerIndex, v)
            
                        i = i + 1
                        Loop
                    End If
                    tmrQuiz = GetTick + 10000
                    End If
                End If
            End If
    That is my current WIP, it works but as I said it repeats the same numbers and the stuff I tried eventually (say only 4 questions left out of the 24 stored, rand would pause the entire game world until it found one of those 4 remaining unused questions) which is something I can't have happen every 10 seconds (testing time only, will be 30 seconds when finished)

    Thanks in advanced,

  2. #2
    Smooth Moperator techgnome's Avatar
    Join Date
    May 2002
    Posts
    34,532

    Re: Random Number, no duplicates

    1) this doesn't belong in the codebank, which is for sharing snips, not asking questions. I'll ask the mods to move it.
    2) change your method of thinking. Think about it like this: let's say you have 10 questions, each on a card and you want to randomly pick one... so you shuffle them and pick one... when you're done with it, do you put it back? probably not. You set it off to the side, then pick from the remaining, which is 9, not 10. So do the same thing. Once you've picked a question, remove it from the array/list/collection/whatever and reduce your max count. Once it's empty, then you know you've been through all of the questions, and can reset your list and start over.

    -tg
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  3. #3
    Super Moderator dday9's Avatar
    Join Date
    Mar 2011
    Location
    South Louisiana
    Posts
    11,711

    Re: Random Number, no duplicates

    I agree with techgnome in that you should rethink how to approach the situation. While I don't program in classic Visual Basic, I'm sure that there is a first in first out (FIFO) collection like a Queue that would be perfect to implement this. Store all of your questions into an Array, then when the user asks for a question check if the FIFO is empty. If the FIFO is empty, repopulate it by randomly ordering the questions in your Array. Otherwise if the FIFO is not empty then dequeue the top-most item from the FIFO to be displayed to the user.
    "Code is like humor. When you have to explain it, it is bad." - Cory House
    VbLessons | Code Tags | Sword of Fury - Jameram

  4. #4
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Random Number, no duplicates

    One quickly (code-wise) way to do this is with a Collection. Use a Collection to store all your random numbers. And then, for every new one, check the Collection for its existence.

    You'd have to use something like the following, with a touch of error trapping to test to see if it's in the Collection:

    Code:
    
    Public Function IsInCollection(coll As Collection, Key As String) As Boolean
        On Error GoTo NotInCollection
        IsObject coll.Item(Key)         ' The actual IsObject function is just used to retrieve the collection.  It doesn't matter if it's an object or not.
        IsInCollection = True
        Exit Function
        '
    NotInCollection:
    End Function
    
    
    Then, when you want to start over, reset your collection, and you're set to begin again.

    There are certainly faster ways, but that'll certainly get it done. I'd just use your random number for both the data and the key of the collection. Since the key is a string, you'd need to do either a CStr() or a Format$() on the number.

    Also, this would work with floating-point numbers, but it would seem that you want integers of some kind. It'd work quite well with integers.

    Good Luck,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  5. #5
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Random Number, no duplicates

    Here, I just quickly threw this together:

    Code:
    
    Option Explicit
    '
    Dim collUsed As New Collection
    '
    
    Private Sub Form_Click()
        Dim bReset As Boolean
        '
        If collUsed.Count = 10 Then
            Debug.Print "----- resetting -----"
            bReset = True
        End If
        Debug.Print UniqueRandomInteger(1, 10, bReset)
    End Sub
    
    
    Public Function UniqueRandomInteger(iMin As Long, iMax As Long, Optional bReset As Boolean = False) As Long
        ' You may want to seed the random number generator before calling this.
        ' Also, if you've used all the options, this function will get hung searching for an unused number.
        '
        If bReset Then Set collUsed = New Collection
        Do
            UniqueRandomInteger = Int((iMax - iMin + 1) * Rnd + iMin)
            If Not IsInCollection(collUsed, CStr(UniqueRandomInteger)) Then
                collUsed.Add UniqueRandomInteger, CStr(UniqueRandomInteger)
                Exit Function
            End If
        Loop
    End Function
    
    Public Function IsInCollection(coll As Collection, Key As String) As Boolean
        On Error GoTo NotInCollection
        ' The actual IsObject function is just used to retrieve the collection.  It doesn't matter if it's an object or not.
        IsObject coll.Item(Key)
        IsInCollection = True
        Exit Function
        '
    NotInCollection:
    End Function
    
    
    Enjoy,
    Elroy

    p.s. To see it in action, just throw the above into a Form1, run it, and start clicking the form and watch your Immediate window.
    Last edited by Elroy; Aug 1st, 2018 at 04:08 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  6. #6
    PowerPoster
    Join Date
    Jun 2001
    Location
    Trafalgar, IN
    Posts
    4,141

    Re: Random Number, no duplicates

    Probably more efficient ways of doing it but I used to do something like this when I need to randomly shuffle something.
    Code:
    Private Sub Command1_Click()
    Dim i As Integer
    Dim col As Collection
    Dim intIndex As Integer
    Dim arrShuffle() As Integer
    Dim UB As Integer
    
        ' number of items to be ramdomized
        UB = 10
        '  call randomize fo seed the randomizer
        Randomize
        
        ' create a collection to hold the items to be randomized
        Set col = New Collection
        ' add the items to the collection
        For i = 1 To UB
            col.Add i, CStr(i)
        Next i
        
        ' dimension the array to hold the randomized items
        i = 0
        ReDim arrShuffle(UB - 1)
        ' pull the next random item from the collection as long as there are still items
        Do While col.Count > 0
            ' get the next random index
            intIndex = Int(Rnd * col.Count) + 1
            ' add the collection item the array and increment the array index
            arrShuffle(i) = col(intIndex)
            i = i + 1
            ' remove the item from the collection so it isn't resused
            col.Remove intIndex
        Loop
        
    '    Just printing the results
        For i = 0 To UB - 1
            Debug.Print arrShuffle(i)
        Next i
    End Sub

  7. #7
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    6,582

    Re: Random Number, no duplicates

    I've just used integers written into an array as the pool of numbers to pick from, like picking numbers from a hat.
    So you choose a random index into the array, but limit the random index to the number of items you haven't picked yet.
    You return the value that was at that index as the question to ask, but you also swap that value with the value at the highest index not yet chosen (the number of questions left) and decrement the number of questions left. Since you use the number of questions left to choose the random index, you will never choose that index or any above it (already picked), so you select each question only once and in a random order.
    If you want to repeat the test, just reset the number of questions left to the maximum, you don't care what order the values are in the array when you start.
    Code:
    Private Sub Command1_Click()
      Debug.Print ReturnQuestion
    End Sub
    
    Private Function ReturnQuestion() As Integer
      Dim Position As Integer, retQuestion As Integer
      
      If QuestionsLeft = 0 Then
        Debug.Print ("All Questions asked, restarting test")
        QuestionsLeft = MaxItems  'to rerun the questions or the test is over
      End If
      
      Position = Int(Rnd * QuestionsLeft)  'choose an unused index from the lower part
      QuestionsLeft = QuestionsLeft - 1    'we have one less question to choose from
      
      retQuestion = QuestionPool(Position)                 'get the question number at that index
      QuestionPool(Position) = QuestionPool(QuestionsLeft) 'swap the last unused question
      QuestionPool(QuestionsLeft) = retQuestion            'with this question
      
      ReturnQuestion = retQuestion                         'return this question
    End Function
    
    Private Sub Form_Load()
      Dim i As Integer
      For i = 1 To MaxItems
        QuestionPool(i - 1) = i
      Next
      QuestionsLeft = MaxItems
      Randomize
    End Sub
    Again, as with Elroy's code, just watch the printout in the Immediate window.
    Last edited by passel; Aug 1st, 2018 at 06:10 PM.

  8. #8
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,418

    Re: Random Number, no duplicates

    Random numbers with no duplicates is the Lottery-Problem (and no, i'm ignoring sorted/unsorted for this)
    There is an entry in the codebank if you look for Lottery-Algorithm/Problem (don't remember if i had algorithm or problem)

    EDIT: Found it!
    http://www.vbforums.com/showthread.p...=1#post4230721

    If the order of the draw is not important you just send the Result-Array to a Quicksort
    Last edited by Zvoni; Aug 3rd, 2018 at 03:17 AM.
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  9. #9
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: Random Number, no duplicates

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Dim i       As Long
        Dim r()     As Long
        Dim max     As Long
        
        ' Maximum number
        max = 1000
        ReDim r(max - 1)
        
        ' Init
        NextRnd True, max
        
        ' Fill
        For i = 0 To max - 1
            r(i) = NextRnd
        Next
    
    End Sub
     
    Private Function NextRnd( _
                     Optional ByVal Reset As Boolean, _
                     Optional ByVal i As Long = 1000) As Long
        Static dat() As Long, Idx As Long, Count As Long
        
        If Reset Then Count = i: ReDim dat(Count - 1): Exit Function
        
        If Count = 0 Then MsgBox "No numbers": Exit Function
        
        Idx = Int(Rnd * Count): NextRnd = dat(Idx): Count = Count - 1
        
        If NextRnd = 0 Then NextRnd = Idx + 1
        If dat(Count) = 0 Then dat(Idx) = Count + 1 Else dat(Idx) = dat(Count)
        
    End Function
    http://www.cyberforum.ru/vba/thread1...ml#post6536079

  10. #10
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Random Number, no duplicates

    benjo,

    If you're just trying to randomize questions on some quiz, I suspect any of these approaches will suffice for your needs. However, if you're wanting a set of "pure" random numbers, you've got at least two problems that none of the above perfectly solves. I'll address the slightly easier one first, the approach to accomplishing non-replacement.

    Even though my approach outlined in post #5 might be the slowest, it may be the only one that guarantees that no bias is introduced. For instance, the line NextRnd = Idx + 1 is almost certainly introducing some degree of bias in The Trick's approach. And, even an approach that goes through, building an ordinal set of numbers, and then swapping each of them with another random location can potentially have bias. If we think about it, if we just go up the numbers, some will get swapped only once while others may be swapped many times, which may introduce bias.

    If we're trying to design a lottery program, there will be people out there who figure out this bias and exploit it.

    Now, the second, more nettlesome problem (which has been discussed elsewhere in these forums). The Rnd function is only a quasi-random-number generator. It's logic-mathematically based and, as such, it's not "truly" random. For a number to be truly random, it must somehow incorporate some real-world stochastic measurement in its derivation. Possibly, the temperature of the CPU or a pause between a person's keystrokes may serve. But that's not part of the Rnd function.

    So, there you have it. There are easy (non-robust) answers, and there are more difficult (robust) answers.

    Good Luck,
    Elroy

    EDIT: And just to say it, the only sure-fire way to determine if a particular approach is "truly" random or has some degree of bias, is to run long-running monte-carlo analyses, and then examine for any consistent patterns. (Well, other than just rigorously outright illustrating a proof for bias.)
    Last edited by Elroy; Aug 3rd, 2018 at 09:21 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  11. #11
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: Random Number, no duplicates

    For instance, the line NextRnd = Idx + 1 is almost certainly introducing some degree of bias in The Trick's approach
    What do you mean?

    Code:
    Option Explicit
    
    Private Const SIZE_PIX  As Long = 15
    
    Dim lPixels()   As Long
    
    Private Function NextRnd( _
                     Optional ByVal Reset As Boolean, _
                     Optional ByVal i As Long = 1000) As Long
        Static dat() As Long, Idx As Long, Count As Long
        
        If Reset Then Count = i: ReDim dat(Count - 1): Exit Function
        
        If Count = 0 Then Err.Raise 5
        
        Idx = Int(Rnd * Count): NextRnd = dat(Idx): Count = Count - 1
        
        If NextRnd = 0 Then NextRnd = Idx + 1
        If dat(Count) = 0 Then dat(Idx) = Count + 1 Else dat(Idx) = dat(Count)
        
    End Function
    
    Private Sub Form_Load()
        
        Randomize
        
        ReDim lPixels(ScaleWidth * ScaleHeight - 1)
    
    End Sub
    
    Private Sub tmrFill_Timer()
        Dim lX  As Long, lY As Long, lI  As Long, lP As Long, lT As Long
        
        On Error GoTo REINIT
        
        For lT = 0 To -Int(-ScaleWidth / SIZE_PIX) * -Int(-ScaleHeight / SIZE_PIX)
        
            lI = NextRnd - 1
            
            lX = lI Mod ScaleWidth: lY = lI \ ScaleWidth
            
            lP = Point(lX, lY)
            PSet (lX, lY), lPixels(lI)
            lPixels(lI) = lP
            
        Next
        
        Exit Sub
        
    REINIT:
        
        NextRnd True, ScaleWidth * ScaleHeight
        
        Resume Next
        
    End Sub
    Attached Files Attached Files

  12. #12
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Random Number, no duplicates

    Quote Originally Posted by The trick View Post
    What do you mean?
    Hey Trick.

    I'm not certain it does, and I'd have to think about it and test it thoroughly before I'd be convinced that it doesn't. I just know that it's easier than we think to introduce some subtle bias in these algorithms without even realizing it. I didn't mean to pick on you. I just saw that and it didn't look purely random.

    Best Regards,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

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