TeleKawaru
asked on
Random Sort
I need to randomly sort a 70 part array.
I have something written now, but it is very slow.
This is how my process works.
Start a loop for 70 items.
Generate a random number between 0 and 69.
Compare that to the numbers already generated.
If the match is found, generate another new number and re-compare against list.
If there is no match found, add the new number to the array and loop until we hit 70 items.
I have something written now, but it is very slow.
This is how my process works.
Start a loop for 70 items.
Generate a random number between 0 and 69.
Compare that to the numbers already generated.
If the match is found, generate another new number and re-compare against list.
If there is no match found, add the new number to the array and loop until we hit 70 items.
ASKER
It was a problem with my logic actually. I got it figured out.
A very quick sub to perform it.
The trick to make it quick is using a dynamic table, where we change the size of the loop when it's bigger.
Dim intArray() As Integer
Private Sub DoRandomNumber()
Dim bSame As Boolean
For i = 0 To 69
myrandom = Int((70 * Rnd) + 1)
ReDim Preserve intArray(i)
bSame = False
For j = 0 To UBound(intArray)
If intArray(j) = myrandom Then bSame = True
Next j
If bSame = False Then
intArray(i) = myrandom
Else
i = i - 1
End If
Next i
End Sub
Private Sub Command1_Click()
DoRandomNumber
End Sub
The trick to make it quick is using a dynamic table, where we change the size of the loop when it's bigger.
Dim intArray() As Integer
Private Sub DoRandomNumber()
Dim bSame As Boolean
For i = 0 To 69
myrandom = Int((70 * Rnd) + 1)
ReDim Preserve intArray(i)
bSame = False
For j = 0 To UBound(intArray)
If intArray(j) = myrandom Then bSame = True
Next j
If bSame = False Then
intArray(i) = myrandom
Else
i = i - 1
End If
Next i
End Sub
Private Sub Command1_Click()
DoRandomNumber
End Sub
Try this:
It algorythm will loop X times for an array of X elements (not more). In this particular case it will loop 70 times.
It doesn't generate a number for each position. It genereates a position for each number.
Theory:
Place 70 positions (addresses into a listboX)
- get first number
- get a random entry from this list
- put the first number to this adress
- remove that address from a listbox (so we won't get it again)
- get second number
- get another random entry from listbox (since we have removed an adreess of the first number, this will return an unique adress)
- put second number to this position
- remove that adress
.
.
.
Here's the code:
- Put comand button and two listboxes on a form
- Names of the listboxes: HelpList and ResultList
-------------------------- ---------- ---------- ---------- ---------- --------
Dim MainArray(0 To 69) As Integer
Dim RandomizedArray(0 To 69) As Integer
Private Sub Command1_Click()
Dim WhereToPut As Integer
Dim HelpIndex As Integer
Dim Number As Integer
Randomize Timer
For x = 0 To 69 'Fill Listbox with numbers (positions)
HelpList.AddItem x
Next x
For x = 0 To 69 'Randomize position for each number (70 times, not more)
Number = MainArray(x) 'get a number for which we are randomising position
HelpIndex = Int(Rnd * (HelpList.ListCount - 1)) 'get random entry from listbox
WhereToPut = HelpList.List(HelpIndex) 'get the number that is under this entry (it is our new position)
RandomizedArray(WhereToPut ) = Number 'put a number into new array to new position
HelpList.RemoveItem (HelpIndex) 'remove this entry. This ensures that we won't try to put two numbers to the same position
Next x
For x = 0 To 69
ResultList.AddItem RandomizedArray(x) 'Display the results
Next x
End Sub
Private Sub Form_Load()
HelpList.Visible = False
For x = 0 To 69
MainArray(x) = x 'fill main array with numbers
Next x
End Sub
It algorythm will loop X times for an array of X elements (not more). In this particular case it will loop 70 times.
It doesn't generate a number for each position. It genereates a position for each number.
Theory:
Place 70 positions (addresses into a listboX)
- get first number
- get a random entry from this list
- put the first number to this adress
- remove that address from a listbox (so we won't get it again)
- get second number
- get another random entry from listbox (since we have removed an adreess of the first number, this will return an unique adress)
- put second number to this position
- remove that adress
.
.
.
Here's the code:
- Put comand button and two listboxes on a form
- Names of the listboxes: HelpList and ResultList
--------------------------
Dim MainArray(0 To 69) As Integer
Dim RandomizedArray(0 To 69) As Integer
Private Sub Command1_Click()
Dim WhereToPut As Integer
Dim HelpIndex As Integer
Dim Number As Integer
Randomize Timer
For x = 0 To 69 'Fill Listbox with numbers (positions)
HelpList.AddItem x
Next x
For x = 0 To 69 'Randomize position for each number (70 times, not more)
Number = MainArray(x) 'get a number for which we are randomising position
HelpIndex = Int(Rnd * (HelpList.ListCount - 1)) 'get random entry from listbox
WhereToPut = HelpList.List(HelpIndex) 'get the number that is under this entry (it is our new position)
RandomizedArray(WhereToPut
HelpList.RemoveItem (HelpIndex) 'remove this entry. This ensures that we won't try to put two numbers to the same position
Next x
For x = 0 To 69
ResultList.AddItem RandomizedArray(x) 'Display the results
Next x
End Sub
Private Sub Form_Load()
HelpList.Visible = False
For x = 0 To 69
MainArray(x) = x 'fill main array with numbers
Next x
End Sub
This is better version of the above algorythm.
It can randomize any array of any type, but number of elements must not be larger that 32767 becouse this is the listbox limit (integer)
LBound doesn't have to start from 0.
-------------------------- ---------- ---------- ---------- ---------- ---------- ------
Private Sub Command1_Click()
Dim MainArray(48 To 61) As String
For x = 48 To 61
MainArray(x) = Chr(x)
Next x
RandomizeArray MainArray
ResultList.Clear
For x = 48 To 61
ResultList.AddItem MainArray(x)
Next x
End Sub
Private Sub Form_Load()
HelpList.Visible = False
End Sub
Sub RandomizeArray(ByRef ArrayToSort As Variant)
Dim WhereToPut As Integer
Dim HelpIndex As Integer
Dim Value As Variant
Dim RandomizedArray() As Variant
ReDim RandomizedArray(LBound(Arr ayToSort) To UBound(ArrayToSort))
Randomize Timer
HelpList.Clear
For x = LBound(ArrayToSort) To UBound(ArrayToSort) 'Fill Listbox with numbers (positions)
HelpList.AddItem x
Next x
For x = LBound(ArrayToSort) To UBound(ArrayToSort) 'Randomize position for each number (70 times, not more)
Value = ArrayToSort(x) 'get a number for which we are randomising position
HelpIndex = Int(Rnd * (HelpList.ListCount)) 'get random entry from listbox
WhereToPut = HelpList.List(HelpIndex) 'get the number that is under this entry (it is our new position)
RandomizedArray(WhereToPut ) = Value 'put this number into new array
HelpList.RemoveItem (HelpIndex) 'remove this entry. This ensures that we won't try to put two numbers to the same position
Next x
For x = LBound(ArrayToSort) To UBound(ArrayToSort)
ArrayToSort(x) = RandomizedArray(x)
Next x
End Sub
-------------------------- ---------- ---------- ---------- ---------- ----
To use it in your existing project, just paste RandomizeArray sub and create a HelpList listbox.
It can randomize any array of any type, but number of elements must not be larger that 32767 becouse this is the listbox limit (integer)
LBound doesn't have to start from 0.
--------------------------
Private Sub Command1_Click()
Dim MainArray(48 To 61) As String
For x = 48 To 61
MainArray(x) = Chr(x)
Next x
RandomizeArray MainArray
ResultList.Clear
For x = 48 To 61
ResultList.AddItem MainArray(x)
Next x
End Sub
Private Sub Form_Load()
HelpList.Visible = False
End Sub
Sub RandomizeArray(ByRef ArrayToSort As Variant)
Dim WhereToPut As Integer
Dim HelpIndex As Integer
Dim Value As Variant
Dim RandomizedArray() As Variant
ReDim RandomizedArray(LBound(Arr
Randomize Timer
HelpList.Clear
For x = LBound(ArrayToSort) To UBound(ArrayToSort) 'Fill Listbox with numbers (positions)
HelpList.AddItem x
Next x
For x = LBound(ArrayToSort) To UBound(ArrayToSort) 'Randomize position for each number (70 times, not more)
Value = ArrayToSort(x) 'get a number for which we are randomising position
HelpIndex = Int(Rnd * (HelpList.ListCount)) 'get random entry from listbox
WhereToPut = HelpList.List(HelpIndex) 'get the number that is under this entry (it is our new position)
RandomizedArray(WhereToPut
HelpList.RemoveItem (HelpIndex) 'remove this entry. This ensures that we won't try to put two numbers to the same position
Next x
For x = LBound(ArrayToSort) To UBound(ArrayToSort)
ArrayToSort(x) = RandomizedArray(x)
Next x
End Sub
--------------------------
To use it in your existing project, just paste RandomizeArray sub and create a HelpList listbox.
Use collection to identify whether the number is generated
So you don't have to loop through your own list
So you don't have to loop through your own list
ie
Option Explicit
Dim col As New Collection
Private Sub Form_Load()
Dim tmp As Integer
On Error Resume Next
Do Until col.Count = 70
tmp = Int((70 * Rnd) + 1)
col.Add tmp, CStr(tmp)
Loop
End Sub
Option Explicit
Dim col As New Collection
Private Sub Form_Load()
Dim tmp As Integer
On Error Resume Next
Do Until col.Count = 70
tmp = Int((70 * Rnd) + 1)
col.Add tmp, CStr(tmp)
Loop
End Sub
actually, a much better appraoch to this problem is to look at it for what it REALLY is, a SHUFFLE (think of suffleing a DECK of 70 cards).
what you want is to have the Numbers from 1 to 70 come up in a random order, with no one number appearing more than once. That is what shuffling a deck of cards produces. The set of cards is fixed, it is just the order that needs to be scrambled.
Where the alogorithms that you are proposing begin to bog down is when the number of REAMINIG values to be generated becomes SMALL (sy you have generated 65 of the 70 values, so only 5 more can be set. But it takes longer to have the Random number genrator actually generate one of those 5 values, and when only two values remain, it takes even longer).
With a Shuffle algorithm, it takes 7 or 8 passes through the array, to completely shuffle the arrsy into a truly random order. Once the array has beenshuffled, then it is a simple matter to step through the arrsy, on value at a time, retriving each RANDOM value.
here is some code to accomplish exactly this:
Dim deck(1 To 70) As Integer 'the array which holds the cards
'the following are just a few counters
Dim n As Integer
Dim temp As Integer
Dim i As Integer
Dim temp1 As Integer
'this statement is used to return differ
' ent random numbers each time we run the
' application
Randomize Timer
'the following loop assigns the numbers
' 1 to 70 to the array in that order.
For n = 1 To 70
deck(n) = n
Next n
'time to do the shuffling
For i = 0 To 9'this llop just repeats the shuffling process 10 times
For temp = 1 To 70
n = Int((70 * Rnd) + 1) this generates a random number in the range 1 To 70
'the following block of code interchange
' s the values of deck(temp) & deck(n). Th
' is is a very simple method of shuffling
' the array. If you read it carefully you
' will be able to understabd the logic.
temp1 = deck(temp)
deck(temp) = deck(n)
deck(n) = temp1
Next temp
Next i
AW
what you want is to have the Numbers from 1 to 70 come up in a random order, with no one number appearing more than once. That is what shuffling a deck of cards produces. The set of cards is fixed, it is just the order that needs to be scrambled.
Where the alogorithms that you are proposing begin to bog down is when the number of REAMINIG values to be generated becomes SMALL (sy you have generated 65 of the 70 values, so only 5 more can be set. But it takes longer to have the Random number genrator actually generate one of those 5 values, and when only two values remain, it takes even longer).
With a Shuffle algorithm, it takes 7 or 8 passes through the array, to completely shuffle the arrsy into a truly random order. Once the array has beenshuffled, then it is a simple matter to step through the arrsy, on value at a time, retriving each RANDOM value.
here is some code to accomplish exactly this:
Dim deck(1 To 70) As Integer 'the array which holds the cards
'the following are just a few counters
Dim n As Integer
Dim temp As Integer
Dim i As Integer
Dim temp1 As Integer
'this statement is used to return differ
' ent random numbers each time we run the
' application
Randomize Timer
'the following loop assigns the numbers
' 1 to 70 to the array in that order.
For n = 1 To 70
deck(n) = n
Next n
'time to do the shuffling
For i = 0 To 9'this llop just repeats the shuffling process 10 times
For temp = 1 To 70
n = Int((70 * Rnd) + 1) this generates a random number in the range 1 To 70
'the following block of code interchange
' s the values of deck(temp) & deck(n). Th
' is is a very simple method of shuffling
' the array. If you read it carefully you
' will be able to understabd the logic.
temp1 = deck(temp)
deck(temp) = deck(n)
deck(n) = temp1
Next temp
Next i
AW
Since TeleKawaru said they figured it out on their own, a refund is considerable, but on the other hand we gave at least 3-4 working sollutions, and since TeleKawaru
didn't bother to close the question, I assume they don't care about the points, but I'll be free to say that the rest of us do.
So I reccomend a split.
On the yet another hand, maybe TeleKawaru doesn't know how to close the question, in that case I would suggest to wait
In any case I wouldn't delete this question, becouse random sorting and shuffling is a common question on EE, so it might be usefull as a PAQ.
didn't bother to close the question, I assume they don't care about the points, but I'll be free to say that the rest of us do.
So I reccomend a split.
On the yet another hand, maybe TeleKawaru doesn't know how to close the question, in that case I would suggest to wait
In any case I wouldn't delete this question, becouse random sorting and shuffling is a common question on EE, so it might be usefull as a PAQ.
ASKER
Hello,
I tried to close the question once I figured out that it was my mistake, but by that time, someone had already posted something so I could not close this question. I was unsure as to what to do by that point, which is why I just posted that I had figured it out. Not sure why so many people gave answers after I had already stated that I solved it myself.
If people would think it is unfair for me to just get a refund, I am willing to split the points, but I would not want to be the one to determine the splitting.
I tried to close the question once I figured out that it was my mistake, but by that time, someone had already posted something so I could not close this question. I was unsure as to what to do by that point, which is why I just posted that I had figured it out. Not sure why so many people gave answers after I had already stated that I solved it myself.
If people would think it is unfair for me to just get a refund, I am willing to split the points, but I would not want to be the one to determine the splitting.
post a 0 point question to community support, asking that this question be deleted, and the points refunded. Explain that you figured out the reason for the problem, on your own.
AW
AW
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
array of numbers or strings?