I need to pick 15 random numbers out of 100. I have searched the forums for help but can't seem to put to use what I've found. Any help is appreciated.
JO
Printable View
I need to pick 15 random numbers out of 100. I have searched the forums for help but can't seem to put to use what I've found. Any help is appreciated.
JO
Thread moved from the FAQ forum.
when you say out of 100, do you mean 1-100? or like a set of 100 different numbers?
Here's an example. I would probably wrap the code up into a more general/reusable function.
Code:Private Function InArray(ByRef IntArray() As Integer, ByVal IntValue As Integer) As Boolean
Dim i As Integer
For i = LBound(IntArray) To UBound(IntArray)
If IntArray(i) = IntValue Then
InArray = True
Exit For
End If
Next i
End Function
Private Sub Form_Load()
Dim i As Integer, r As Integer
Dim intPicked(1 To 15) As Integer
Dim intFind As Integer
Randomize
For i = 1 To 15
Do
r = Int(Rnd * 100) + 1
Loop Until Not InArray(intPicked, r)
intPicked(i) = r
Debug.Print i & vbTab & r
Next i
Erase intPicked
End Sub
well this will only work if you want numbers between 1-100, otherwise just use digiCode:Private Sub cmdRandom_Click()
List1.Clear
Randomize
Dim i As Integer
Dim x As Integer
Do While x < 15
i = (Rnd(i + 8) * 100)
List1.AddItem (i)
x = x + 1
Loop
End Sub
Here's a slightly different approach. The following code generates 100 unique integers, scrambles them all, selects the first 15, and displays the results in a list box. These will be a randomly obtained set of unique integers.
Code:Dim MyNums() As Integer, Temp As Integer
Const PoolSize = 100, SampleSize = 15
Private Sub Form_Load()
ReDim MyNums(PoolSize)
Randomize
For I = 1 To PoolSize
MyNums(I) = I
Next
For I = 1 To PoolSize
Temp = Int(Rnd * PoolSize) + 1
MyNums(Temp) = MyNums(I)
MyNums(I) = Temp
Next
For I = 1 To SampleSize
List1.AddItem MyNums(I)
Next
End Sub
Code Doc's approach is the preferred one, but on closer inspection his shuffling algorithm looks flawed. In fairness, I don't know why it's flawed, but it is. Knuth's shuffle isn't supposed to randomly pick from the entire list, but instead randomly pick from only the as-yet-unshuffled part of the list. Again, I don't know why, but that's how it's supposed to work.
Here's some code:Code:Private Sub Form_Load()
Randomize
End Sub
Private Sub Command1_Click()
Dim lngArray(1 To 100)
Dim i As Long
For i = 1 To 100
lngArray(i) = i
Next
ShuffleArray lngArray
List1.Clear
For i = 1 To 15
List1.AddItem lngArray(i)
Next
End Sub
' Knuth shuffle (very fast)
Public Sub ShuffleArray(pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngReplace As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMax To iMin + 1 Step -1
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Next
End Sub
The only 'problem' with Code_Doc's approach is that it's possible for duplicate numbers to be selected and will marginally affect the overall 'randomness'.
heh, that's a much bigger flaw than the one I was talking about.Quote:
Originally Posted by Doogle
This is another approach that use a collection.
Someone may say it's not very good if [Sample] equals or nearly equals to [Pool].
Code:Function RandomPick(Pool As Long, Sample As Long) As Long()
'-- Randomly pick [Sample] numbers from a pool of numbers from 1 to [Pool]
Dim myColl As New Collection
Dim arPick() As Long, n As Long, i As Long
If (Pool <= 0) Or (Sample <= 0) Or (Pool < Sample) Then
ReDim RandomPick(0) '-- noted that lowerbound = 0 here
Exit Function
End If
Randomize
On Error Resume Next
Do Until myColl.Count >= Sample
n = Int(Rnd * Pool) + 1
myColl.Add n, Str(n)
Loop
On Error GoTo 0
ReDim arPick(1 To myColl.Count) '-- noted that lowerbound = 1 here
For i = 1 To myColl.Count
arPick(i) = myColl.Item(i)
Next
Set myColl = Nothing
RandomPick = arPick
End Function
Code:'--Usage:
Dim arPick() As Long, i As Long
arPick = RandomPick(100, 15)
For i = 1 To UBound(arPick)
Debug.Print arPick(i)
Next
I'm all for optimized/perfect code but seems kind of overkill if the guy just wants a simple way to pick out 15 random numbers from 1-100. :D
In addition to stating requirements more clearly (post#3), apt code also depends on use, e.g. simulate drawing from deck of cards.
Doogle is correct, that could happen during the shuffle, so swaps could be cancelled out. That is possible with any selection of random numbers. You could randomly select 100 integers form 1 to 100 in sequence that were all the same--improbable but possible. Does "forcing" a non-duplicate swap improve the randomness? I don't think it does. In fact that could distort the solution.Quote:
Originally Posted by Doogle
Using Monte Carlo simulation techniques, I have checked using Chi-Square the scrambling routine I posted above. After N = 50% of the original array is swapped randomly, the scrambled distribution no longer statistically resembles the sorted one. I have checked this using hundreds of iterations. So, my swapping 100% of the original array of the code above is probably overkill.
This is my version
Hope this helps...Code:Sub RandNos()
Dim nums() As Integer
Dim maxval As Integer
Dim Ptr As Integer
Dim j As Integer, k As Integer
Randomize
'Change this value as per you requirements
'Currently you want 15 random numbers out of 100
maxval = 100
ReDim nums(maxval, 2)
'Fill the initial array
For j = 1 To maxval
nums(j, 1) = j
nums(j, 2) = Int((Rnd * maxval) + 1)
Next j
'Sort the array based on the random numbers
For j = 1 To maxval - 1
Ptr = j
For k = j + 1 To maxval
If nums(Ptr, 2) > nums(k, 2) Then Ptr = k
Next k
If Ptr <> j Then
k = nums(Ptr, 1)
nums(Ptr, 1) = nums(j, 1)
nums(j, 1) = k
k = nums(Ptr, 2)
nums(Ptr, 2) = nums(j, 2)
nums(j, 2) = k
End If
Next j
'Generate 15 Random Numbers
Ptr = 0
For k = 1 To 15
Ptr = Ptr + 1
'you can output it wherever you want
MsgBox nums(Ptr, 1)
Next k
End Sub
The reason it's allowing duplicates is because you are using the random number as both an array index and an array value, which is odd. It works for this particular application so it's all good, but it's a quirky thing. And that's the only reason that duplicates could be introduced. To avoid the duplicates is a simple fix:Quote:
Originally Posted by Code Doc
I would point out that without this modification, your solution is functionally equivalent to just populating a 100-element array with random numbers and not swapping any elements at all.Code:For I = 1 To PoolSize
Temp = Int(Rnd * PoolSize) + 1
SwapValue = MyNums(Temp)
MyNums(Temp) = MyNums(I)
MyNums(I) = SwapValue
Next
This is over my head mathematically. All I know about shuffling is that it is a problem that is considered to be solved. I just this minute learned that Donald Knuth didn't invent it, but rather popularized it. But hey, I think the "Knuth Shuffle" sounds way cooler than the Fisher-Yates Shuffle, so I'm keeping the name. Note that most of those articles make a big deal about bias, which can be quite tricky when devising a shuffling algorithm.Quote:
Originally Posted by Code Doc
Code Doc is also quite right.
There's a difference between 'a selection of Random Numbers' and 'a Random selection of Numbers'. (I believe that the OP was after the latter.)
The former requires a distribution such that the probability of selection of any number is the same for each number in the Distribution and does not change. (brief definitinon of a Random Distribution)
The latter requires a 'selection method' such that the probability of selecting a given number is the same for each number.
My 'Logic' was to say that if I had a set of integer numbers between 1 and 100 inclusive, the probability of any given number being returned from the selection process should be 0.01 (1/100). If I then replaced the number '100' with the number '1' the probability of the selection process returnig a '1' is now 0.02 whilst the probability of returing any of the other numbers remains at 0.01. Hence the 'randomness' of the selection result is marginally affected. The probablity of selecting any given element in the list of numbers remains the same (0.01). Clear as mud :confused:
EDIT: It's a bit like "Deal or no Deal", the contestant randomly selects a box but it's what's inside the box that's important. If there were two boxes with 1 pence (UK) in them then I suspect the show would lose it's popularity.
Saying all that, I learnt a long time ago that Logic and Statistics do not necessarily always share the same space. :D
Doogle said, "... Saying all that, I learnt a long time ago that Logic and Statistics do not necessarily always share the same space."
----------------
+1! and look at it his way. Suppose I somehow managed in 100 tries to obtain 50 duplicate swaps during the shuffle that canceled each other out. The odds of even doing that are unbelievably small. Then I somehow do another 50 swaps that do not cancel each other out and you still have a random scramble.
That's why when I ran my Chi Square goodness of fit test 1000 times or so with 1000 different shuffles, I never could produce a shuffled array that resembled the original array. Here's a discussion of Chi Square:
http://www2.chass.ncsu.edu/garson/pa765/chisq.htm
Simply line up the arrays (1 to 100) in two columns, calculate the Chi Square, and throw the results into a list box or message box. Then repeat the shuffle as many times as you want, calculating Ch Square each time. It's amazing how fast the PC can do this. The larger the Chi Square, the less likely the distributions agree:
The null hypothesis is that the original array and the shuffled array are the same after shuffling. You need to see a value of Chi Square that exceeds 140 to reject that hypothesis with the probability of being wrong at 0.005. I've never calculated a Chi-Square value less than 2,000 in over 1,000 tries with either PoolSize or PoolSize/2 swaps.Code:Dim MyNums() As Integer, Temp As Integer
Const PoolSize = 100, SampleSize = 15
Private Sub Command1_Click()
Dim ChiSq As Single
ReDim MyNums(PoolSize)
Randomize
For I = 1 To PoolSize
MyNums(I) = I
Next
For I = 1 To PoolSize
Temp = Int(Rnd * PoolSize) + 1
MyNums(Temp) = MyNums(I)
MyNums(I) = Temp
Next
' Now Calculate Chi Square
For I = 1 To PoolSize
ChSq = ChSq + (MyNums(I) - I) ^ 2 / I
Next
List1.AddItem Format$(ChSq, "###,###.00")
End Sub
However, with a (for example) PoolSize = 4 and SampleSize = 2 it goes a bit Pear shaped.
Wikipedia says that Code Doc's method has a bias. (It's never a good sign when your algorithm shows up in the "Implementation Errors" section of a wikipedia article. heh.) This is almost certainly responsible for the "pear shaped" results using very small pools.Again, the problem of shuffling a list has already been solved. The Knuth shuffle is the preferred method.Quote:
Similarly, always selecting k from the entire range of valid array indexes on every iteration (i.e. using k = rng.nextInt(array.length) in the Java example above) also produces a result which is biased, albeit less obviously so. This can be seen from the fact that doing so yields NN distinct possible sequences of swaps, whereas there are only N! possible permutations of an N-element array. Since NN can never be evenly divisible by N! (as the latter is divisible by N−1, which shares no prime factors with N), some permutations must be produced by more of the NN sequences of swaps than others.
Ellis Dee said, "Again, the problem of shuffling a list has already been solved. The Knuth shuffle is the preferred method."
------------------
Looks interesting. Actually, it would be easy to modify my code so that you exit the swap loop faster when the criterion is met. It looks like that a simple modification of just swapping PoolSize/2 times rather than PoolSize times would not be too bad. The concern appears to be that too many swaps can actually work against you, even though PoolSize swaps would run very fast for even an enormous array.
Hmmm... Ellis, I wonder if we could merge the two ideas of using Chi Square calculations with an incremental number of random swaps to determine when to actually terminate the swapping? For example, in the current case where Chi Square exceeds 200 or so, you stop swapping. I think the stochastic approach to the shuffle still has some merit. When to stop swapping is a function of the array size, of course, so the Chi Square stopping criterion would have to be adjusted.
On second thought, that won't work. If only a few extreme cases within the array get swapped early (such as 1 and 100 or 2 and 99), the critical value of Chi Square would be exceeded and I assure you that the new array would not be random.
Nitpick: It's actually PoolSize-1 swaps, not PoolSize. Anyway, the advantage of PoolSize-1 swaps is that it generates every possible permutation an equal number of times. Messing with the number of swaps unbalances the number of possible permutations you can end up with, which means you'll end up with a (slightly) biased shuffle.Quote:
Originally Posted by Code Doc
Bias is a tricky thing when trying to shuffle. Best not to tinker with a known, unbiased solution.
According to that wikipedia article, the method of assigning each element a random number and then sorting by the random numbers has a bias if you don't force each random number to be unique. The reason is that the way sorting algorithms handle duplicate keys isn't random. And looking at your algorithm, it appears you're using Insertion Sort as the sorting algorithm, which is a stable sort. So any duplicate keys will retain their original order.Quote:
Originally Posted by koolsid
Even with unstable algorithms, the final order of duplicate keys is not easily predictable, but they are not technically random.
To illustrate, consider if your first random number is 37, which gets assigned to 1. You're generating 99 more random keys, and if any of them are also 37 -- actually a fairly high probability -- then those elements are forced to be after element 1 due to the stable sorting algorithm.
In short, this method has a subtle bias favoring lower numbers ending up earlier in the list.
OK, I have revised my code to use Donald Knuth's algorithm method to perform the random swaps. I believe this looks good:
Note that this appears to knock out the possibility of identical swaps while limiting the number of swaps to the PoolSize. However, you will likely generate more than PoolSize random numbers because occasionally the random number (Temp) will equal the RangeLimit that is being constantly reduced inside the While ... Wend loop. That is likely a small sacrifice if bias is removed. My results indicate that only about 5 to 10% more swaps will occur and sometimes no additional swaps are required.Code:Dim MyNums() As Integer, Temp As Integer
Dim RangeLimit As Integer, SwapValue As Integer
Const PoolSize = 100, SampleSize = 15
Private Sub Command1_Click()
ReDim MyNums(PoolSize)
Randomize
For I = 1 To PoolSize
MyNums(I) = I
Next
RangeLimit = PoolSize
While RangeLimit > 1
Do
Temp = Int(Rnd * RangeLimit) + 1
If Temp <> RangeLimit Then Exit Do
Loop
SwapValue = MyNums(Temp)
MyNums(Temp) = MyNums(RangeLimit)
MyNums(RangeLimit) = SwapValue
RangeLimit = RangeLimit - 1
Wend
List1.Clear
For I = 1 To SampleSize
List1.AddItem Str$(MyNums(I))
Next
End Sub
Thanks, Ellis. I'll adjust my future scarmbling routines accordingly if this also looks good to you and to the rest of the forum.
Looks (very) good to me :thumb:
It is still biased, though in a different way. When looping through and doing the swapping, the swap pool needs to be all the remaining elements including the one you're on. You are forcing it to be different than the current one, so it introduces a fairly obvious bias: whatever element starts in last place cannot possibly end up in last place. Imagine you're shuffling an array of two elements; with this implementation, your algorithm will only allow exactly one possible outcome. An unbiased algorithm would end up with two possible outcomes, both equally likely.Quote:
Originally Posted by Code Doc
As I said, bias is a tricky thing when dealing with shuffling algorithms. Best not to try and reinvent the wheel, but rather just stick with what works. I posted the finished solution as my first post in this thread. It includes a self-contained function for doing an unbiased Knuth shuffle on any array. Here is my post again:vb Code:
Ellis Dee said, "It is still biased, though in a different way. When looping through and doing the swapping, the swap pool needs to be all the remaining elements including the one you're on. You are forcing it to be different than the current one,...."
----------
Good point, but in my own defense, let's look at the wording of the publication you directed me to read. The instructions for Durstenfield's version of the Knuth shuffle include the following two steps:
1. Build an array of n values.
2. Pick a random number k between 1 and n inclusive (n = array size).
3. If k <> n, swap the kth and nth values of the array.
4. Decrease n by 1.
5. Repeat from step 2 until n is less than 2.
That's what I tried to program in VB6. Note that step 3 above insists that k <> n, and that's why I include the Do ... Loop in my code to block it. If we eliminate that Do .... Loop filter, then that allows the array element to be swapped with itself and no shuffle would occur should the random number that is generated equal the current array element.
Perhaps Durstenfield was concerned that for small arrays, you could have the same random number (though not likely) generated n times and the shuffle thus "dies" as it manages to produce an array that is identical to the original.
Now you have 15 numbers all between 1 and 100, stored into an array of Num(14)Code:
For X = 0 to 14
Num(X) = INT(RND * 100) + 1
Next X
P.s don't forget the Randomize Timer function. Unless you want a sudo random output.
And why the heck is everyone's code so long and complicated, I think this is all he wanted?
Yes your code if fine if you don't mind getting the same number more then once, Ellis's ShuffleArray code seems more of a non-repeatable random.Quote:
Originally Posted by Barqers
Everyone else's code is longer because they are preventing duplicates.Quote:
Originally Posted by Barqers
Oh, okay.
Just to clarify, I'm not criticizing you. It's a very easy mistake to make, as evidenced by the fact that it is specifically mentioned in the "implementation errors" section. That section would be blank if these weren't commonly made errors.Quote:
Originally Posted by Code Doc
Durstenfield's algorithm is the one from my implementation. The only difference is that if k = n, I go ahead and swap them anyway. I consider that inefficiency negligible, and it slightly reduces the code complexity.
Step 2 is the critical one. "Pick a random number k between 1 and n inclusive." The value "n" isn't the array size, but rather the looping value, as we can see from step 4. (Decrease n by 1.) The key word in step 2 is "inclusive." In other words, when randomly picking numbers, n is a valid choice.
Step 3 tells us that we can skip swapping if the randomly chosen element is the element we're swapping with. It saves cpu cycles by not bothering to swap an element with itself. It doesn't add any other command to that case; eg: there is no directive to repeat step 2 until k <> n.
So if in step 3, the random number chosen is n, we do nothing and then move on to step 4: Decrease n by 1 and go back to step 2.
I agree that the wording can easily be misinterpreted. When you already know what it's supposed to do, it's clear that the wording is very carefully chosen and quite precise. But IMO, anyone unfamiliar with the algorithm is likely to to fall into a similar trap as the one you did.
It's clearly not my algorithm, but even further it's not really my code, either. I originally adapted it from code posted by Logophobic.Quote:
Originally Posted by Edgemeal
Credit where credit's due.
When I run this code, I get a runtime 424 error towards the list1.additem or list1.clear
Why is this?
Because you don't have a Listbox named List1 on your form. Change the code to reflect the actual name of your listbox, or if you aren't using a listbox remove that whole section of code and just display the first 15 array elements however you please.Quote:
Originally Posted by Barqers
Ohhh, that would make A LOT of sense.
Thank you =]
François
Bias or not bias? Do we need to prove that the Rnd() function is not bias or just assume that?
Below is the proof of the algorithm used by Ellis in post#25.
Quote:
Random Shuffles
This is more difficult. We have a list (x1,..., xn) and we want to shuffle it randomly.
The following, surprisingly simple, algorithm does the trick:
Why does this work? It seems that it is not doing enough 'mixing up' to produce a genuinely random shuffle. We can only prove that it works if we have some notion of what we mean by a 'random shuffle'. Let me keep things simple and say that a shuffling process is random if each element of the list can end up in any position in the list with equal probability. That is to say, in a list of n items there are n possible places that any given element can eventually occupy. I want each of these places to be equally likely.Code:algorithm shuffle(x,n) // shuffle x1,..., xn
begin
for i = n downto 2 begin
k = irand(1,i)
swap over xi and xk
end
end
So we now have to calculate the probability that our algorithm puts element xi into position j, where 1 <= i, j <= n. If you look carefully at the algorithm you will see that element xi end up in position j if it is not chosen on the first n - j steps of the algorithm and is chosen on the step n - j + 1. Since we know that irand(n, m) is genuine we can use elementary methods to find that the probability of xi ending up in position j is
which is exactly what we wanted.Code:n-1 n-2 n-3 j 1 j 1 1
--- · --- · --- · ··· · --- · - = - · - = -
n n-1 n-2 j+1 j n j n
Okay so i understand the lngArray() numbers which we are shuffling. i is the range of numbers which lngArray() gets stored. iMin is the minimum number in the range while iMax is the maximum number in the range. And I also understand the Ubound is the highest number of the number placed in brackets? and Lbound the opposite? Sort of ? not too sure on those concepts, BUT
what does pvarArray do...
what does varSwap do...
AND last but not least,
what does lngReplace do?
are these just variables which toss around the numbers? Like I'm understanding pretty much all the code except for:
This is the original code from post #7 (Ellis Dee):Code:lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
If someone wouldn't mind explaining each step individually that'd be much appreciated.Code:Private Sub Form_Load()
Randomize
End Sub
Private Sub Command1_Click()
Dim lngArray(1 To 100)
Dim i As Long
For i = 1 To 100
lngArray(i) = i
Next
ShuffleArray lngArray
List1.Clear
For i = 1 To 15
List1.AddItem lngArray(i)
Next
End Sub
' Knuth shuffle (very fast)
Public Sub ShuffleArray(pvarArray As Variant)
Dim i As Long
Dim iMin As Long
Dim iMax As Long
Dim lngReplace As Long
Dim varSwap As Variant
iMin = LBound(pvarArray)
iMax = UBound(pvarArray)
For i = iMax To iMin + 1 Step -1
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Next
End Sub
A bit off-topic, but I don't see the harm.
what does pvarArray do...
pvarArray is a variant array. It's really just a regular ol' variant, but the name is meant to convey that it will accept an array. Variants can accept any typed array -- except UDTs -- so this makes the function nice and versatile. It means we can shuffle string arrays, long arrays, date arrays, etc...
what does varSwap do...
varSwap is a variant that will temporarily hold an array value during the swap. Whenever swapping two values, you save the first to a temp variable, overwrite the first with the second, then overwrite the second with the temp variable. This also must be a variant in order to maintain the versatility discussed above.
what does lngReplace do?
lngReplace is the randomly generated array index of the element we want to swap the current element with.
I'm understanding pretty much all the code except for:The first line identifies which element we want to swap with. Random numbers are generated using the following formula:Code:lngReplace = Int((i - iMin + 1) * Rnd + iMin)
varSwap = pvarArray(i)
pvarArray(i) = pvarArray(lngReplace)
pvarArray(lngReplace) = varSwap
Int((Maximum - Minimum + 1) * Rnd + Minimum)
The actual code is:
lngReplace = Int((i - iMin + 1) * Rnd + iMin)
We can see through simple substitution that the Maximum is i, and the minimum is iMin. This is consistent with how the algorithm is supposed to work.
I'm a VB6 quasi-rookie but I have a task for which I need your assistance. I have 10 forms, each has 4 sound files. The request is that I have the forms and audio files randomized (each playing only once) and all lead to a response form (same one). Would it be best to create an array of 40 different forms or can it be done without the duplication. If so, what would the code be (of those above) and where would it go (Module, form?)?
--feel free to point at laugh
vdriscoll, recommend starting your own thread. Hijacking others' threads isn't appropriate.
Hijacking: using thread for your own questions/problems