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.
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.
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.
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
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.
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.Ty peLib")
Debug.Print objScript.Guid
ie
Set objScript = CreateObject("Scriptlet.Ty
Debug.Print objScript.Guid
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=""
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)
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!
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
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
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(TestQuest ons(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
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(TestQuest
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
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
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.
:)
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
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!
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!
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
> 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