• Home
 · 
• String Manipulation
 · 
• qsort

qsort

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).

Inputs
strList (a string array)

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).

Returns
strList (the same array - sorted)

API Declarations



Rate qsort

• 1
• 2
• 3
• 4
• 5

(3(3 Vote))

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:  strList  String array              :::'
 ':::       lLbound  Lower bound to sort (usually 1)     :::'
 ':::       lUbound  Upper 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 [email protected]    :::'
 '::: 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