Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

QuickSort - Sort Arrays using the QuickSort Algorithm
[ All Languages » VB »  Arrays]

Total Hit ( 1188)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 



Click here to copy the following block
' QuickSort an array of any type
' QuickSort is especially convenient with large arrays (>1,000
' items) that contains items in random order. Its performance
' quickly degrades if the array is already almost sorted. (There are
' variations of the QuickSort algorithm that work good with
' nearly-sorted arrays, though, but this routine doesn't use them.)
'
' NUMELS is the index of the last item to be sorted, and is
' useful if the array is only partially filled.
'
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
'
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub QuickSortS(arr() As Single, Optional numEls As Variant,
' '   Optional descending As Boolean)
'  Dim value As Single, temp As Single

Sub QuickSort(arr As Variant, Optional numEls As Variant, _
  Optional descending As Boolean)

  Dim value As Variant, temp As Variant
  Dim sp As Integer
  Dim leftStk(32) As Long, rightStk(32) As Long
  Dim leftNdx As Long, rightNdx As Long
  Dim i As Long, j As Long

  ' account for optional arguments
  If IsMissing(numEls) Then numEls = UBound(arr)
  ' init pointers
  leftNdx = LBound(arr)
  rightNdx = numEls
  ' init stack
  sp = 1
  leftStk(sp) = leftNdx
  rightStk(sp) = rightNdx

  Do
    If rightNdx > leftNdx Then
      value = arr(rightNdx)
      i = leftNdx - 1
      j = rightNdx
      ' find the pivot item
      If descending Then
        Do
          Do: i = i + 1: Loop Until arr(i) <= value
          Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
          temp = arr(i)
          arr(i) = arr(j)
          arr(j) = temp
        Loop Until j <= i
      Else
        Do
          Do: i = i + 1: Loop Until arr(i) >= value
          Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
          temp = arr(i)
          arr(i) = arr(j)
          arr(j) = temp
        Loop Until j <= i
      End If
      ' swap found items
      temp = arr(j)
      arr(j) = arr(i)
      arr(i) = arr(rightNdx)
      arr(rightNdx) = temp
      ' push on the stack the pair of pointers that differ most
      sp = sp + 1
      If (i - leftNdx) > (rightNdx - i) Then
        leftStk(sp) = leftNdx
        rightStk(sp) = i - 1
        leftNdx = i + 1
      Else
        leftStk(sp) = i + 1
        rightStk(sp) = rightNdx
        rightNdx = i - 1
      End If
    Else
      ' pop a new pair of pointers off the stacks
      leftNdx = leftStk(sp)
      rightNdx = rightStk(sp)
      sp = sp - 1
      If sp = 0 Then Exit Do
    End If
  Loop
End Sub


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.