Sort an Array
Manuel Schmitz
Manuel Schmitz
Ogilvy, Thomas, W., Mr., ODCSLOG
On method would be to write the array to the worksheet, sort it there
and pick it back up in an array.
Another method would be to write your own sort routines.
Here is one posted by Woodies Office Watch newsletter:
Sub TestSort()
Dim A(1 To 5) As Variant
A(1) = "AAbb"
A(2) = "xxaa"
A(3) = "qqbb"
A(4) = "zzaa"
A(5) = "11bb"
ShellSortArray A()
Debug.Print A(1)
Debug.Print A(2)
Debug.Print A(3)
Debug.Print A(4)
Debug.Print A(5)
End Sub
Private Sub ShellSortArray(A() As Variant)
'
' VB Valet
' Wow # 3.51 12/7/98
'
Dim i As Integer, j As Integer
Dim Low As Integer, Hi As Integer
Dim PushPop As Variant
Low = LBound(A)
Hi = UBound(A)
j = (Hi - Low + 1) \ 2
Do While j > 0
For i = Low To Hi - j
If A(i) > A(i + j) Then
PushPop = A(i)
A(i) = A(i + j)
A(i + j) = PushPop
End If
Next i
For i = Hi - j To Low Step -1
If A(i) > A(i + j) Then
PushPop = A(i)
A(i) = A(i + j)
A(i + j) = PushPop
End If
Next i
j = j \ 2
Loop
End Sub
HTH,
Tom Ogilvy
David J. Braden
20 to 200 values, than what WOW posted. (I didn't test other array sizes, as I
would tend to use another algorithm for larger arrays). This also uses less code.
Private Sub ShellSortArray2(A As Variant)
'Translation of Shell's Sort as described in
'Numerical Recipes in C, 2nd edition, Press et al.
Dim intI As Integer, intJ As Integer, intK As Integer
Dim v As Variant
intK = 1
Do While intK <= UBound(A)
intK = 3 * intK + 1
Loop
Do
intK = intK \ 3
For intI = intK + 1 To UBound(A)
v = A(intI)
intJ = intI
Do While A(intJ - intK) > v
A(intJ) = A(intJ - intK)
intJ = intJ - intK
If intJ <= intK Then Exit Do
Loop
A(intJ) = v
Next
Loop While intK > LBound(A)
End Sub
More to follow.
Regards,
Dave Braden
TMY Research
David J. Braden
Ich habe ein Bisschen mehr Auskunft um Sortierung. Mein Deutsch ist
offensichtlich fürchtbar, aber wenn Sie ein Problem mit was ich geschrieben
habe, schreib mal.
This is a quick note, with code and tests, on some sorting algorithms for VBA.
Tom Ogilvy reposted the ShellSortArray algorithm (below) for sorting. Myrna
Larson posted
QuickSort2 (below) as part of an effort for an unusual application. Below these
are improvements on each routine (ShellSortArray2 and Qsort). I've done a lot of
testing on these. Here are the results.
I found ShellSortArray2 to be from 30% to 45% faster than ShellSortArray for
arrays of size n = 10, 50, 150, 500, and 4000 both for randomly ordered data and
inverse-sorted data.
For these same test sizes, QSort is anywhere from 15% to 28% faster then
QuickSort2. For n=500, Qsort is 30% faster than ShellSortArray2, and for n=4000
it is 78% faster.
I coded and tested my best stab at Heapsort, but it was a dog. I also used
XL97's sort: jam an array to a blank column, use Range().sort, read the array,
erase the mess, and found it to be competitive speed-wise with QSort when n >
6000. Downside of using this approach is the garbage that XL leaves in a
workbook when one adds sheets, processes and then deletes the sheets, or, as I
did, simply writes to a column, does a sort and then cleans up afterwards.
Sorting suggestions:
(1) IMO, use a VBA routine instead of XL's sort; writing an array to a worksheet
and sorting it, then cleaning up, leaves too much hidden detritis behind; let's
hope MS cures this bug, which btw exists in XL95, XL97 and XL98 (MAc).
(2) If your array has less than about 200 elements, use ShellSortArray2,
particularly if the data are partially ordered.
(3) If you anticipate arrays that are longer then 200 elements, seriosly
consider QSort. If the array is partially sorted already then QSort greatly
outperforms QuickSort2, and is competitve with ShellSortArray2. QSort has the
additional advantage over QuickSort2 in not using those unsightly "GoTo"
statements <vbg
to Tom, Myrna and Steve>, but at the obvious cost of more code.
(4) If the app is critical, then all this is not nearly as good as doing the
sort in, say, C, called from a DLL. My tests in C were similar to these:
Heapsort is useless, ShellSort has its uses, the QSort algorithm is great for
arrays the OS can handle, and then it's on to merge sort.
Happy Holidays to all!
Dave Braden
TMY Research
------------------------
Private Sub ShellSortArray(a As Variant)
'
' VB Valet
' Wow # 3.51 12/7/98
'
Dim i As Integer, j As Integer
Dim Low As Integer, Hi As Integer
Dim PushPop As Variant
Low = LBound(a)
Hi = UBound(a)
j = (Hi - Low + 1) \ 2
Do While j > 0
For i = Low To Hi - j
If a(i) > a(i + j) Then
PushPop = a(i)
a(i) = a(i + j)
a(i + j) = PushPop
End If
Next i
For i = Hi - j To Low Step -1
If a(i) > a(i + j) Then
PushPop = a(i)
a(i) = a(i + j)
a(i + j) = PushPop
End If
Next i
j = j \ 2
Loop
End Sub
Sub QuickSort2(list As Variant, ByVal Min As Long, ByVal Max As Long)
'Rod Stephens' version: slightly faster than "standard"
Dim Med_Value ' As Double
Dim Hi As Long
Dim Lo As Long
Dim i As Long
If Max <= Min Then Exit Sub
i = Int((Max - Min + 1) * Rnd + Min)
Med_Value = list(i)
list(i) = list(Min)
Lo = Min
Hi = Max
Do
Do While list(Hi) >= Med_Value
Hi = Hi - 1
If Hi <= Lo Then
list(Lo) = Med_Value
GoTo QSDone
End If
Loop
list(Lo) = list(Hi)
Lo = Lo + 1
Do While list(Lo) < Med_Value
Lo = Lo + 1
If Lo >= Hi Then
Lo = Hi
list(Hi) = Med_Value
GoTo QSDone
End If
Loop
list(Hi) = list(Lo)
Loop
QSDone:
QuickSort2 list, Min, Lo - 1
QuickSort2 list, Lo + 1, Max
End Sub
-------------------------------
Private Sub ShellSortArray2(a As Variant)
'Translation of Shell's Sort as described in
' "Numerical Recipes in C", 2nd edition, Press et al.
'For large arrays, consider Quicksort. This algorithm is at least
'as good up to about 100 or so elements. But with 500 randomized
'elements it is about 27% slower than QSort, and looks
'increasingly worse as the array size increases.
'Dec 17, '98 - David J. Braden
Dim intI As Integer, intJ As Integer, intK As Integer
Dim v As Variant
If UBound(a) = LBound(a) Then Exit Sub
intK = 1
Do While intK <= UBound(a): intK = 3 * intK + 1: Loop
Do
intK = intK \ 3
For intI = intK + 1 To UBound(a)
v = a(intI)
intJ = intI
Do While a(intJ - intK) > v
a(intJ) = a(intJ - intK)
intJ = intJ - intK
If intJ <= intK Then Exit Do
Loop
a(intJ) = v
Next
Loop While intK > LBound(a)
End Sub
Sub QSort(list As Variant)
Const InsertParm = 7
Const NSTACK = 50
Dim i As Long, r As Long, j As Long, k As Long, L As Long
Dim cStack As Integer, lngStack() As Long
Dim a As Variant, temp As Variant
r = UBound(list)
L = 1
ReDim lngStack(1 To NSTACK) As Long
Do
If r < InsertParm + L Then
For j = L + 1 To r
a = list(j)
For i = j - 1 To 1 Step -1
If list(i) <= a Then Exit For
list(i + 1) = list(i)
Next
list(i + 1) = a
Next
If cStack = 0 Then Exit Do
r = lngStack(cStack): cStack = cStack - 1
L = lngStack(cStack): cStack = cStack - 1
Else
'k = Int((L - r + 1) * Rnd + r) 'This line selects element randomly
'along the lines of Myrna's code. In principal it can be faster, but
'in my tests it was never faster in VBA. To test it yourself, uncomment
'the line and comment out the next one. (DJB)
k = (L + r) \ 2
temp = list(k): list(k) = list(L + 1): list(L + 1) = temp
If list(L + 1) > list(r) Then temp = list(L + 1): list(L + 1) =
list(r): list(r) = temp
If list(L) > list(r) Then temp = list(L): list(L) = list(r): list(r) = temp
If list(L + 1) > list(L) Then temp = list(L + 1): list(L + 1) =
list(L): list(L) = temp
i = L + 1
j = r
a = list(L)
Do
Do While list(i) < a: i = i + 1: Loop
Do While list(j) > a: j = j - 1: Loop
If j < i Then Exit Do
temp = list(i): list(i) = list(j): list(j) = temp
Loop
list(L) = list(j)
list(j) = a
cStack = cStack + 2
If (r - i + 1 >= j - L) Then
lngStack(cStack) = r
lngStack(cStack - 1) = i
r = j - 1
Else
lngStack(cStack) = j - 1
lngStack(cStack - 1) = L
L = i
End If
End If
Loop
End Sub
David J. Braden
Didn't mean to imply it was your routine. In fact, the code I got from you, and
reposted, graciously noted the source, which both you and I have a thing about.
And if SPEED is what you are concerned with, then by all means check out the
routine I offered as an alternative. It is apparantly faster for any size array
of randomly generated data, and for sorted and inverse-sorted arrays as well
(quicksort's weak point.)
With all respect to Rod Stephen's credentials, if what I offer is faster by
anywhere from 20 to 78%, then what's the problem?
I'm also trying to help the NG with other aproaches, and to get a sense of the
time/code trade-offs when using other algorithms or even XL's sort. Now you have
a faster QuickSort, at the expense of more code. You also have (I hope) a better
sense of when you might want to use the ShellSort I posted.
Regards,
Dave Braden
TMY Research
Myrna Larson wrote:
>
> On Sun, 20 Dec 1998 16:55:43 -0500, "David J. Braden" <t...@fiastl.net> wrote:
>
> >Myrna Larson posted QuickSort2
>
> Yes, I posted it, and you refer to it as *my* routine, but it isn't.
>
> As I said originally, it was posted by Rod Stephens on a Compuserve forum. Rod
> has taught algorithms at MIT, and he's written a book entitled "Visual Basic
> Algorithms", ISBN 0-471-13418-X.
>
> Given Rod's credentials, I'd be very hesitant to ridicule his use of GOTO, if I
> were you <g>. The routine shown here is faster than the one he gives in his
> book, by about 10%. The latter doesn't use GOTO. Since SPEED is what QuickSort
> is all about, I'll let you draw your own conclusions.
>
> --
> Myrna Larson
> e-mail to: myrna...@csi.com
Myrna Larson
Laurent Longre
>
> As I said originally, it was posted by Rod Stephens on a Compuserve forum. Rod
> has taught algorithms at MIT, and he's written a book entitled "Visual Basic
> Algorithms", ISBN 0-471-13418-X.
Just for the historical precision, the QuickSort algorithm was invented
by Charles Antony Richard Hoare (England) in 1962.
Laurent
Myrna Larson
Yes, that's correct, but Stephens has a new twist (or 2) compared with the
Hoare's original, which I why I mentioned where it came from.
Marco Schreuder
When I read this thread, I thought there must be some way to use the
worksheetfunction rank or large to make a quick sort.
I did not got to it until today:
Option Base 1
Option Explicit
Sub sortArray()
Dim oldArray, newArray
Dim i As Integer, N As Integer
' Make the oldArray based on contents A1:A10 transposed to make it 1D
oldArray = Range("A1:A10")
oldArray = Application.Transpose(oldArray)
' Determine size of oldArray
N = UBound(oldArray)
' Make a new (sorted) array based on values of oldArray
ReDim newArray(1 To N)
For i = 1 To N
newArray(N + 1 - i) = Application.Large(oldArray, i)
Next i
' Look at the result in the immediate window
For i = 1 To N
Debug.Print newArray(i)
Next i
End Sub
Of course this routine wil only work on numbers.
But apart from that it is fast and does not mess up your workbook.
Regards
Marco Schreuder
The Netherlands E-mail: ma...@insumma.demon.nl
Manuel Schmitz wrote in message <75dh9c$kpl$1...@news12.btx.dtag.de>...
David J. Braden
And compared to the routines supplied earlier, quite slow.
Here are some data from runs on a PowerPC, OS 8.1, XL98; given some comparisons
shared with Myrna Larson lately on related matters, I think these will be
indiciative of what you will find on a Win system with XL9x. Sorry I couldn't
run these on my win OS, but I just messed up my system board. :(
Array Len QSort SS2 SortArray InsertSort
10 1 1 6 1.1
200 1 1 24 6
4000 1 1.8 341 84
Tests were run for arrays of length 10, 200, and 4000 of randomly generated data
over quite a few loops to get a reasonable average. Time to run the loop and
generate data, with no other action, was subtracted from each of the totals. Run
times are normalized so that QSort (my implementation of QuickSort, posted
earlier, based on that in Numerical Recipes in C) is 1. "SS2" is the version of
ShellSort I posted earlier; it too is based on that in Num Rec in C. The 4th
column shows times for your idea. Even a straight insertion sort (last column,
code below) is at least 4 times faster.
For my money, if I "know" I'll only be sorting very short arrays (n < 20) I
would use InsertSort or SS2. BTW, I tested these against the best
implementations I could find/think of for HeapSort and BubbleSort; InsertSort
dominates BubbleSort, ShellSort dominates HeapSort. ShellSort takes about the
same amount of coding and storage as HeapSort but is at least as fast; likewise
for InsertSort vs. BubbleSort. If I "know" my arrays can be as large as n=200
or so, I would only consider SS2 or QSort, the latter requiring more code and
storage. For larger arrays, definitely Qsort, up to the point when I need to
switch to MergeSort. But by the time it gets there, I've already coded this up
with C in a DLL. Here's the InsertSort code:
Sub InsertSort(list As Variant)
Dim i As Integer, j As Integer
Dim a As Variant
If UBound(list) = LBound(list) Then Exit Sub
For j = 2 To UBound(list)
a = list(j)
For i = j - 1 To 1 Step -1
If list(i) <= a Then Exit For
list(i + 1) = list(i)
Next
list(i + 1) = a
Next
End Sub
And so you know what I tested of your suggestion, here it is:
Sub sortArray(list As Variant)
Dim newArray
Dim i As Integer, N As Integer
' Determine size of list
N = UBound(list)
' Make a new (sorted) array based on values of list
ReDim newArray(1 To N)
For i = 1 To N
newArray(N + 1 - i) = Application.Large(list, i)
Next i
End Sub
Thanks for your input. If you can improve on these ideas, please let us know.
Happy New Year!
Dave Braden
TMY Research
Marco Schreuder
>Thanks for the input, Marco. But as you point out, it only works for
numbers.
>And compared to the routines supplied earlier, quite slow.
You are right it is not a fast routine.
I have made some changes to speed things up:
Option Base 1
Sub SmallSortArray()
Dim av, ai
av = Array(9, 1, 7, 4, 8, 10) 'or any other array of numbers!
' We need an index array (1,2,3...) as a second argument of the SMALL
function
ReDim ai(1 To UBound(av)) As Integer
For i = 1 To UBound(av): ai(i) = i: Next i
' And 1 statement to sort the array using worksheetfunction SMALL;
av = Application.Small(av, ai)
End Sub
This seems to work well and fast.
Although I did not find time to time it or test it with large arrays !