VB icon

qsort

Email
Submitted on: 1/1/2015 2:57:00 PM
By: Mike Shaffer (from psc cd)  
Level: Not Given
User Rating: By 3 Users
Compatibility: VB 3.0, VB 4.0 (16-bit), VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 1284
 
     Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: qsort
' Description:Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
' By: Mike Shaffer (from psc cd)
'
' Inputs:strList (a string array)
'
' Returns:strList (the same array - sorted)
'
' Assumes:Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
'**************************************

Public Function QSort(strList() As String, lLbound As Long, lUbound As Long)
 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
 '::::::'
 '::: Routine:QSort :::'
 '::: Author:Mike Shaffer (after Rod Stephens, et al.) :::'
 '::: Date: 21-May-98 :::'
 '::: Purpose:Very fast sort of a string array :::'
 '::: Passed:strListString array:::'
 '::: lLboundLower bound to sort (usually 1) :::'
 '::: lUboundUpper bound to sort (usually ubound()) :::'
 '::: Returns:strList(in sorted order):::'
 '::: Copyright: Copyright *c* 1998, Mike Shaffer :::'
 '::: ALL RIGHTS RESERVED WORLDWIDE :::'
 '::: Permission granted to use in any non-commercial:::'
 '::: product with credit where due. For free:::'
 '::: commercial license contact mshaffer@nkn.net:::'
 '::: Revisions: 22-May-98 Added and then dropped revision :::'
 '::: using CopyMemory rather than the simple swap :::'
 '::: when it was found to not provide much benefit.:::'
 '::::::'
 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
 Dim strTemp As String
 Dim strBuffer As String
 Dim lngCurLow As Long
 Dim lngCurHigh As Long
 Dim lngCurMidpoint As Long
 
 lngCurLow = lLbound' Start current low and high at actual low/high
 lngCurHigh = lUbound
 
 If lUbound <= lLbound Then Exit Function ' Error!
 lngCurMidpoint = (lLbound + lUbound) \ 2 ' Find the approx midpoint of the array
 
 strTemp = strList(lngCurMidpoint) ' Pick as a starting point (we are making
' an assumption that the data *might* be
' in semi-sorted order already!
 
 Do While (lngCurLow <= lngCurHigh)
 Do While strList(lngCurLow) < strTemp
lngCurLow = lngCurLow + 1
If lngCurLow = lUbound Then Exit Do
 Loop
 
 Do While strTemp < strList(lngCurHigh)
lngCurHigh = lngCurHigh - 1
If lngCurHigh = lLbound Then Exit Do
 Loop
 If (lngCurLow <= lngCurHigh) Then ' if low is <= high then swap
 strBuffer = strList(lngCurLow)
 strList(lngCurLow) = strList(lngCurHigh)
 strList(lngCurHigh) = strBuffer
 '
 lngCurLow = lngCurLow + 1 ' CurLow++
 lngCurHigh = lngCurHigh - 1' CurLow--
 End If
 
 Loop
 
 If lLbound < lngCurHigh Then ' Recurse if necessary
 QSort strList(), lLbound, lngCurHigh
 End If
 
 If lngCurLow < lUbound Then' Recurse if necessary
QSort strList(), lngCurLow, lUbound
 End If
 
End Function


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Not Given category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.