Link to home
Start Free TrialLog in
Avatar of williari2003
williari2003

asked on

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

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.
Avatar of sunnycoder
sunnycoder
Flag of India image

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
Avatar of [ fanpages ]
[ fanpages ]

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.
may be use


YYYYMMDDHHmmss as number
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.
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
Avatar of williari2003

ASKER

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.
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=""
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)
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!
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
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
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
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
>> 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
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.
>> KarcOrigin was the first to post a shuffling algorithm.

Indeed he was, apologies to KarcOrigin for missing that.
 :)
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
Thanks Idle_Mind that you have noticed and no problems jimbobmcgee.

Cheers!
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!
ASKER CERTIFIED SOLUTION
Avatar of redfordb
redfordb

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial