Solved

Random Numbers  - from a set list not repeating within that list.

Posted on 2004-09-27
20
2,141 Views
Last Modified: 2008-01-09
I am creating an application which is basically a quiz. The idea is the user gets asked a country and they have to type in the appropriate capital of that quiz e.g. USA - Washington DC, France - Paris , etc...

I have created a text file in the root of the project folder called quiz.txt and the layout is as follows:

UK|London
France|Paris
Brazil|Brasilia etc...

The pipe sign is my delimeter.

I pull in the values from the txt file and store them in to arrays Capital and Country respectively. I then generate a random number, using a min value of 1 and a max value of the number of countries in the array.

This works successfully however it is still possible for it to chuck up and country at any time e.g. UK 3 times in a row. I want to know how to not generate a number that has already been generated.

Thanks.
0
Comment
Question by:williari2003
  • 2
  • 2
  • 2
  • +9
20 Comments
 
LVL 45

Expert Comment

by:sunnycoder
ID: 12159013
Hi williari2003,

> This works successfully however it is still possible for it to chuck up and country at any
> time e.g. UK 3 times in a row. I want to know how to not generate a number that has already
> been generated.

Suppose you have n (0 to n-1)elements in the array. Choose a prime number k such that k < n. Try to keep k as large as possible. You can change the number k dynamicaly in order to generate questions in a different sequence in subsequent runs.

First question will be Q1
second will be Q(1+k)%n
third will be (1+2k)%n
and so on

Sunnycoder
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 12159051
Alternatively, store the last random number generated in a variable, say "intOld_Index", and then generate your random number, say "intCurrent_Index", in a loop until the two are not equal.

e.g.

Option Explicit
Public Sub Q_21146182()

  Dim intOld_Index                                      As Integer
  Dim intCurrent_Index                                  As Integer
  Dim intMax_Index                                      As Integer
  Dim intQuestion                                       As Integer

' Initialise...

  intOld_Index = 0
  intCurrent_Index = 0
  intMax_Index = 20     ' Number of items in file

' Main processing...

  For intQuestion = 1 To 50
 
     Do
 
         Randomize
         intCurrent_Index = (Rnd(1) * intMax_Index) + 1
     
     Loop Until (intCurrent_Index <> intOld_Index)
   
     Debug.Print intCurrent_Index
     
' Store & loop again...

     intOld_Index = intCurrent_Index
     
  Next intQuestion

End Sub



BFN,

fp.
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12159138
may be use


YYYYMMDDHHmmss as number
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 12159228
PS. Did you want non-repeating random questions across the whole list, or just non-repeating consecutive numbers?

If the latter, I can dig out my MS-Excel (VBA) code posted to a previous question (in the MS-Excel forum) for somebody asking for the same.

Basically you just maintain an array of the numbers already "selected" (randomly) and ensure that future numbers are not one of these.

BFN,

fp.
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12159255
Instead of using number, you should use GUID, this string must be unique according to MS


ie

Set objScript = CreateObject("Scriptlet.TypeLib")
Debug.Print objScript.Guid
0
 

Author Comment

by:williari2003
ID: 12159356
I have a set range say 1- 20, i want it to dish out random numbers within this range but only numbers it hasn't dealt with before e.g. if 12 has been select for the first instance then everything from 1 - 20 is available except 12 leaving 19 free numbers.
0
 
LVL 1

Expert Comment

by:crjor
ID: 12159449
Why don't you use a third array element called 'used' or 'someting'?
Do the randomization on the select and set the array element to true.

Loop through your array while used=""
0
 
LVL 6

Expert Comment

by:Amritpal Singh
ID: 12159663
hi the code is in c (actually ,i have a tight hand in vb)
however u can follow the logic and convert it to vb
i finds the randm nos. from 1-16 without repeating any number
getrandomnos()
{
      int i, j, n, equal ;
      int p[16] ;

      for ( i = 0 ; i <= 15 ; i++ )
            p[i] = 0 ;

      for ( i = 0 ; i <= 14 ; )
      {
            n = rand( ) % 16 ;

            if ( n == 0 )
                  continue ;

            equal = 0 ;
            for ( j = 0 ; j < i ; j++ )
            {
                  if ( p[j] == n )
                  {
                        equal = 1 ;
                        break ;
                  }
            }

            if ( equal != 1 )
            {
                  p[i] = n ;
                  i++ ;
            }
      }

      for( i = 0 ; i <= 3 ; i++ )
      {
            for( j = 0 ; j <= 3 ; j++ )
            {
                  m_a[i][j] = p[i*4+j] ;
            }
      }
}
i hope it'll be of any help
and sorry for the code in C
and sorry if i'm going against the rules(C code in VB forum)
0
 
LVL 5

Expert Comment

by:KarcOrigin
ID: 12159782
Try this:

Call this function on button click:

Eg:

Call RandomNumbers(10, 1, 10, True)

Public Function RandomNumbers(Upper As Integer, _
                                Optional Lower As Integer = 1, _
                                Optional HowMany As Integer = 1, _
                                Optional Unique As Boolean = True) As Variant
    On Error GoTo LocalError
    If HowMany > ((Upper + 1) - (Lower - 1)) Then Exit Function
    Dim x           As Integer
    Dim n           As Integer
    Dim arrNums()   As Variant
    Dim colNumbers  As New Collection
   
    ReDim arrNums(HowMany - 1)
    With colNumbers
        'First populate the collection
        For x = Lower To Upper
            .Add x
        Next x
        For x = 0 To HowMany - 1
            n = RandomNumber(0, colNumbers.Count + 1)
            arrNums(x) = colNumbers(n)
            If Unique Then
                colNumbers.Remove n
            End If
        Next x
    End With
    Set colNumbers = Nothing
    RandomNumbers = arrNums
   
    Dim i   As Integer
    ' Just to check
    For i = LBound(arrNums) To UBound(arrNums)
        Debug.Print arrNums(i)
    Next
   
Exit Function
LocalError:
    'Justin (just in case)
    RandomNumbers = ""
End Function


Public Function RandomNumber(Upper As Integer, _
     Lower As Integer) As Integer
    'Generates a Random Number BETWEEN the LOWER and UPPER values
    Randomize
    RandomNumber = Int((Upper - Lower + 1) * Rnd + Lower)
End Function

I have given you the base logic of generating the random unique numbers now it will be easy for you to scramble the order of the records according to the number generated by my function. Moreover just to display the random number i have added the debug.Print statement inside the function only.

Cheers!
0
 
LVL 6

Expert Comment

by:Amritpal Singh
ID: 12159817
hi the equivelent code in vb for above c code is as
Dim i As Integer, j As Integer, n As Integer, equal As Integer
 
    Dim p(1 To 16) As Integer

    For i = 1 To 16
        p(i) = 0
    Next
    i = 1
    While i < 16
label:
        n = Rnd() Mod 16

        If (n = 0) Then
            GoTo label
        End If
        equal = 0
        For j = 1 To i
       
            If (p(j) = n) Then
           
                equal = 1
                Exit For
            End If
        Next

        If (equal <> 1) Then
       
            p(i) = n
            i = i + 1
        End If
   
    Wend
    For i = 1 To 16
    Debug.Print p(i)
    Next
plz have a look

however you shud initialize the seed fro rnd function before calling that function
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12159960
Option Explicit

Private Sub Form_Load()
    Randomize Timer
End Sub

Private Sub Command1_Click()
    Dim i As Integer
    Dim selected As Variant
   
    ' pick 20 values from 1 to 100
    selected = generateSet(1, 100, 20)
    For i = LBound(selected) To UBound(selected)
        Debug.Print i & " = " & selected(i)
    Next i
End Sub

Private Function generateSet(ByVal rangeMin As Integer, ByVal rangeMax As Integer, ByVal setSize As Integer) As Variant
    Dim rangesize As Integer
    Dim rangeSet() As Integer
   
    Dim i As Integer
    Dim r As Byte
    Dim swapWith As Integer
    Dim tempInt As Integer
   
    ' compute the size of the range
    rangesize = rangeMax - rangeMin + 1
   
    ' make sure the input parameters make sense...
    If rangeMax < rangeMin Then
        MsgBox "rangeMax must be greater than or equal to rangeMin"
        Exit Function
    End If
    If setSize <= 0 Or setSize > rangesize Then
        MsgBox "setsize must be greater than zero and less than or equal to the range size"
        Exit Function
    End If
   
    ' resize our array
    ReDim rangeSet(rangesize - 1)
   
    ' build the range set
    For i = 0 To rangesize - 1
        rangeSet(i) = i + rangeMin
    Next i
   
    ' shuffle the range set 7 times
    For r = 1 To 7
        ' for each item in the set,
        ' pick another item and
        ' swap them
        For i = 0 To rangesize - 1
            swapWith = Int(rangesize * Rnd)
            tempInt = rangeSet(i)
            rangeSet(i) = rangeSet(swapWith)
            rangeSet(swapWith) = tempInt
        Next i
    Next r
                 
    ' return the selected set
    ReDim Preserve rangeSet(setSize - 1)
    generateSet = rangeSet
End Function
0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12160323
The following is a simple engine for your quiz.  From the looks of things its a simplification of Idle Mind's code, so you should credit him also, if you use it.  

I have not declared my variables, however...


Sub GenerateAndRunTest()

'Create and populate question numbers array
Dim Questions(1 to 100) as integer
For q=1 to 100
   Questions(q) = q
Next q

'Start shuffle routine
For q=1 to 100
   Temp = Questions(q)
   Randomize Timer
   RndQ = Int(Rnd*100+1)
   Questions(q) = Questions(RndQ)
   Questions(RndQ) = Temp
Next q

'Generate 20-question list
Dim TestQuestions(1 to 20) as integer
For q=1 to 20
   TestQuestions(q) = Questions(q)
Next q

'Run test
For q=1 to 20
   If InputBox(Country(TestQuestons(q)) = Capital(TestQuestions(q)) then score = score + 1
Next q
MsgBox score

End Sub


The code creates an array of numbers, then shuffles it.  No number repeats itself because the Questions array does not contain more than one of any number.  Once the shuffle has taken place, it takes the first 20 numbers and stores them in another array (this step can be shortened and was only included for clarity).  The final part shows entries from the Country array, where the array element number matches that stored in the TestQuestions array and checks the user input against the relevant answer.

If you want to randomize it further, you could enclose the shuffle routine inside another For/Next loop.

HTH
0
 
LVL 4

Expert Comment

by:kurian2z5
ID: 12160500
ArrLen is the no of items in the array.
Str contains the list of numbers to choose from in string form seperated by ","
Nos is your array of random numbers split from Str

It picks a random number, displays it, and shifts the items in the array, starting from the random item, downwards by one step thus deleting the number chosen.

Private ArrLen As Integer
Private Nos() As String
Private Str As String

Private Sub Command1_Click()
Dim i As Integer, Temp As String, Index As Integer

If ArrLen > 0 Then

    Index = Int(Rnd * ArrLen)
    Print Nos(Index)
    ArrLen = ArrLen - 1

    For i = Index To ArrLen - 1
        Nos(i) = Nos(i + 1)
    Next i

Else
    MsgBox "No more items in array"
End If
End Sub

Private Sub Form_Load()

Randomize
ArrLen = 10
Str = "1,2,3,4,5,6,7,8,9,0"
Nos = Split(Str, ",")

End Sub
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 12160519
>> From the looks of things its a simplification of Idle Mind's code, so you should credit him also, if you use it.  

Than you for the credit jimbobmcgee, but my code is the second submission of the type that "shuffles" a set like a deck of cards.

KarcOrigin was the first to post a shuffling algorithm.

~IM
0
 
LVL 4

Expert Comment

by:kurian2z5
ID: 12160544
actually when i saw the length of the code posted here i just started and wrote mine from scratch! i never read any of it.
0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12160957
>> KarcOrigin was the first to post a shuffling algorithm.

Indeed he was, apologies to KarcOrigin for missing that.
 :)
0
 
LVL 5

Expert Comment

by:Leithauser
ID: 12163301
The simple way is to create an array to keep track of whether a number has been picked. Say your random number generator is

X=Int(Rnd * N) +1

which generates a number from 1 to N. Use this code


Public Used(1 to N)

Function GenerateRandomNumber() as Integer

Dim X as Integer
Static TimesUsed as integer

If TimesUsed = N then
     MsgBox "No more numbers left.",,"Sorry"
     Exit Function
End if

TryAgain:
X=Int(Rnd * N) +1
If Used(X) then Goto TryAgain
Used(X) = True
GenerateRandomNumber = X
TimesUsed = TimesUsed + 1

End Function

     This simply checks to make sure X has not been used before. If it has, the generator tries another number. You need to keep track of how many times the function has been called, because if it has been used N times, you will get an endless loop. TimesUsed takes care of that.

If/when you want to reset so you can use the old numbers again (another player, for example), just do

Sub Reset ()

Dim X as Integer

For X = 1 To N
    Used(X) = False
Next X

End Sub
0
 
LVL 5

Expert Comment

by:KarcOrigin
ID: 12165571
Thanks Idle_Mind that you have noticed and no problems jimbobmcgee.

Cheers!
0
 
LVL 1

Expert Comment

by:crjor
ID: 12166996
Try this


Option Explicit
Dim quiz(20, 2) As String

Private Sub Command1_Click()
    Static i As Integer
    Dim n As Integer
    Dim q As String
    Dim a As String
    Dim x As String
   
    Command1.Enabled = False
    x = "x"
    While x = "x"
        n = Int(Rnd * 20)
        x = quiz(n, 2)
    Wend
   
    Text1.Text = quiz(n, 0)
    Text2.Text = quiz(n, 1)
    quiz(n, 2) = "x"
    i = i + 1
    If i < 20 Then
        Command1.Enabled = True
        Caption = "Question " & CStr(i)
    Else
        Caption = "Final Question (" & CStr(i) & ")"
    End If
   
End Sub

Private Sub Form_Load()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Your upload code goes here
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim i As Integer
   
    For i = 0 To 20
        quiz(i, 0) = "country" & Chr(65 + i)
        quiz(i, 1) = "capital" & Chr(65 + i)
    Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

cya!
0
 
LVL 3

Accepted Solution

by:
redfordb earned 250 total points
ID: 12167409
A way to make sure you can only ask each question once.
Bascially this example does the following...
1) Reads all of the questions into a collection
2) Chooses a random question in the collection, asks it and then removes the question from the collection. - It cycles through all the questions till all have been asked.
    Since the question is removed after being asked it cannot be asked again.

Try it in a new project and adapt to your requirements.

Create a new project

Add a new class to your project ie clsCountryCapital.
In the new class create two public variables ie...

Public Country         As String
Public Capital          As String

Copy and paste the below code into a form in the project... Take note to change the input file location.

Option Explicit

Private collQuestion    As New Collection

Private Sub Clear_Questions()
    While collQuestion.Count > 0
        collQuestion.Remove (1)
    Wend
End Sub

Private Sub Load_Questions()
Dim tmpArr()            As String
Dim tmpLine             As String
Dim tmpCountryCapital   As New clscountryCapital

    'Clear question collection
    Clear_Questions
   
    'Open file - change to the location of your file
    Open "C:\Questions.txt" For Input As 1
   
    'Load contents of file into collection
    While Not EOF(1)
        Set tmpCountryCapital = New clscountryCapital
        Line Input #1, tmpLine
        tmpArr = Split(tmpLine, "|")
        tmpCountryCapital.Country = tmpArr(0)
        tmpCountryCapital.Capital = tmpArr(1)
        collQuestion.Add tmpCountryCapital
        Set tmpCountryCapital = Nothing
    Wend
   
    'Close file
    Close 1
End Sub

Private Sub Ask_Questions()
Dim tmpCountryCapital   As New clscountryCapital
Dim lngPTR              As Long
Dim strAnswer           As String

    'Ask all of the questions
    While collQuestion.Count > 0
        lngPTR = Int(Rnd * collQuestion.Count) + 1
        Set tmpCountryCapital = collQuestion(lngPTR)
        'Ask Question
        strAnswer = InputBox("What is the capital of " & tmpCountryCapital.Country & " ?")
       
        'Evaluate strAnswer
        If strAnswer = tmpCountryCapital.Capital Then
            MsgBox "Correct"
        Else
            MsgBox "Wrong"
        End If
        'Remove question from list - prevents question from being asked twice
        collQuestion.Remove lngPTR
    Wend
End Sub

Private Sub Form_Load()
    Randomize
    Load_Questions
    Ask_Questions
End Sub

Private Sub Form_Terminate()
    'Clear question collection
    Clear_Questions
End Sub



0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now