About This Code
Brief Description:
Array sort
Contributor:
Magnus Nilsson
Notes Version:
R4.x, R5.x, R6.x
Last Modified:
04 Jul 2002
OpenNTF Disclaimer
All of the program code and information presented in the OpenNTF.org Code Bin are provided "as-is", and should be used at your own risk. OpenNTF.org make no express or implied warranty about anything in the Code Bin, and OpenNTF.org will not be responsible or liable for any damage caused by the use or misuse of anything from this site. OpenNTF.org makes no guarantees about anything. Please thoroughly test all of the knowledge and code you find here before you attempt to use them in your production environment.
Code / Description
This function requires an array and the lower and upper bound of the array as input. The values are then sorted and returns the sorted array as output.
'=============================================================
' Function Quick sort.
' Sorts array
'=============================================================
Public Function QuickSort( anArray As Variant, indexLo As Long, indexHi As Long) As Variant
Dim lo As Long
Dim hi As Long
Dim midValue As String
Dim tmpValue As String
lo = indexLo
hi = indexHi
If ( indexHi > indexLo) Then
'get the middle element
midValue = anArray( (indexLo + indexHi) /2)
While ( lo <= hi )
'find first element greater than middle
While (lo < indexHi) And (anArray(lo) < midValue )
lo = lo+1
Wend
'find first element smaller than middle
While ( hi > indexLo ) And ( anArray(hi) > midValue )
hi = hi - 1
Wend
'if the indexes have not crossed, swap
If ( lo <= hi ) Then
tmpValue = anArray(lo)
anArray(lo) = anArray(hi)
anArray(hi) = tmpValue
lo = lo+1
hi = hi -1
End If
Wend
' If the right index has not reached the left side of array, sort it again
If( indexLo < hi ) Then
Call QuickSort( anArray, indexLo, hi )
End If
'If the left index has not reached the right side of array, sort it again
If( lo < indexHi ) Then
Call QuickSort( anArray, lo, indexHi )
End If
End If
QuickSort = anArray
End Function
Usage / Example
Comments
Posted by Simo Viitanen on 07/26/2002 03:12:13 AMMHO on quicksort
I think in a script it's not wise to pass the whole array in every recursion call of the function
for it increases the size of the recursion stack excessively.
So my idea is to hava a global variable that holds the array and then have only the indexes passed
in recursion.
Sth like this :
[<PRE STYLE="line-height:6pt;">]
(Declarations)
' Global variable
Private Slot_Array As Variant
Public Function QuickSort( anArray As Variant) As Variant
Slot_Array = anArray
' run QuickSort
Call recQuickSort( Lbound( Slot_Array ), Ubound ( Slot_Array ) )
QuickSort = Slot_Array
End Function
Private Function recQuickSort(Lower As Integer, Upper As Integer)
%REM
Do recursive sorting. Pass only indexes to each recursion.
%END REM
If Lower < Upper Then
M% = Partition( Lower, Upper )
' break up the array and sort the values
Call QuickSort( Lower, M% - 1 )
' recusive call on the lower half of the array
Call QuickSort( M% + 1, Upper )
' recusive call on the upper half of the array
End If
End Sub
Function Partition( Lower As Integer, Upper As Integer ) As Integer
' set up the midValue$ index and the midValue$ vlaues for each array
midValue$ = Slot_Array(lower + (Upper - lower) \ 2)
' exchange the value in the midValue$ index with the lower bound value
Slot_Array(lower + (Upper - lower) \ 2) = Slot_Array(lower)
' start lo% at the lower bound + 1; hi% gets the upper bound
lo% = lower + 1
hi% = Upper
Do
'find first element greater than middle
Do While lo% < hi%
tmpValue$ = Slot_Array(lo%)
If midValue$ <= tmpValue$ Then Exit Do
lo% = lo% + 1
Loop
'find last element smaller than middle
Do While hi% >= lo%
tmpValue$ = Slot_Array(hi%)
If tmpValue$ <= midValue$ Then Exit Do
hi% = hi% - 1
Loop
'if the indexes have not crossed, swap
If lo% >= hi% Then Exit Do
tmpValue$ = Slot_Array(lo%)
Slot_Array(lo%) = Slot_Array(hi%)
Slot_Array(hi%) = tmpValue$
tmpValue$ = Slot_Array(lo%)
hi% = hi% - 1
lo% = lo% + 1
Loop
' set the lower bound element to the value indexed at hi%
Slot_Array(lower) = Slot_Array(hi%)
' set the value indexed at hi% to the midValue$ value
Slot_Array(hi%) = midValue$
' return hi% to the calling routine
' this is where the next call to partition will pick up and break apart the array
Partition = hi%
End Function
[</PRE>]
Posted by Julle Nilsson on 10/14/2002 09:46:30 AMI've had no problems
Posted by Julle Nilsson on 07/03/2003 09:11:44 AMI've had no problems
Input appreciated. To this day I haven't had any problems with my routine, it's fast and small but
if this becomes an issue I'll try yours.