Visual Basic Sort Routine Library
Pure VB: Quick, Shell, Bubble and Selection Sort Performance Comparisons
     
Posted:   Thursday June 5, 1997
Updated:   Monday December 26, 2011
     
Applies to:   VB3, VB4-16, VB4-32, VB5, VB6
Developed with:   VB4-32, Windows 95
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

Pure VB: Quick, Shell, Bubble and Selection Sort Performance Comparisons
Pure VB: QuickSort Variations
Pure VB: Sorting Date Arrays using QuickSort
Pure VB: Applying and Understanding the QuickSort

     
 Prerequisites
None.

The base application shown here was obtained over the web, from an unknown author.

The actual application consists of 2 parts - the first, a simple 30-element sort comparison (in the upper frame), and the second a more intense speed comparison between the 4 sort methods presented.

I have added code to display the actual number of times (iterations) the various routines swapped values; this code is commented and should be removed for any actual implementation of any sort method here.

In addition, because the Bubble and Selection sorts can take a very long time with a large number of items to sort, I have added "Skip" buttons to abort that aspect of the speed test. I realize that the addition of DoEvents somewhat skews the time reported to perform the Bubble and Selection sorts, but not as much as you might think.

As this is a complex form, I've tried to make things as simple as possible.

To a form, add three frames (Frame1, 2 & 3), eight command buttons (Command1 through Command8), one text box (Text1), and sixteen labels (Label1 through Label16). Set the label's autosize to True before pasting additional copies. The form load event takes care of positioning and parenting the controls into the respective form, as well as aligning the forms and exterior controls.  If your system uses small fonts on your system the form will look like the illustration. Large font users will have to tweak the values in the form load to allow for the larger text.


 BAS Module Code
None.

 Form Code
Add the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'variables for the Quick sort
'iteration as the sub is recursive
Private QSCallCnt As Long
Private QSSwaps As Long

'used to abandon long sorts
Private SkipFlag As Long

Private tmrCounter As Long  'used for the counter in the speed test
Private sortMethod As Long  'flag for the timer


Private Sub Form_Load()

   Randomize
   Me.Width = 8500
   
  'FRAME 1 CONTROLS .......
   With Frame1
      .Caption = "Perform sort of 30 random elements"
      .Move 200, 200, Me.ScaleWidth - 350, 1600
   End With
   
   Label1.Caption = "Unsorted:"
   Set Label1.Container = Frame1
   Label1.Move 200, 300
   
   Label2.Caption = "Sorted:"
   Set Label2.Container = Frame1
   Label2.Move 200, 600
   
   Label3.Caption = ""
   Set Label3.Container = Frame1
   Label3.Move 1000, 300
   
   Label4.Caption = ""
   Label4.ForeColor = RGB(0, 0, 212)
   Set Label4.Container = Frame1
   Label4.Move 1000, 600
   
   Command1.Caption = "Bubble Sort"
   Set Command1.Container = Frame1
   Command1.Move 1000, 1050, 1400
   
   Command2.Caption = "Selection Sort"
   Set Command2.Container = Frame1
   Command2.Move 2550, 1050, 1400
   
   Command3.Caption = "Shell Sort"
   Set Command3.Container = Frame1
   Command3.Move 4100, 1050, 1400

   Command4.Caption = "Quick Sort"
   Set Command4.Container = Frame1
   Command4.Move 5700, 1050, 1400
   
  'FRAME 2 CONTROLS .......
   With Frame2
      .Caption = "Perform Speed Comparison"
      .Move 200, 2000, Me.ScaleWidth - 3100, 2550
   End With
   
   Label5.Caption = "Number of Random Elements:"
   Set Label5.Container = Frame2
   Label5.Move 200, 350
   
   Text1.Text = "1000"
   Set Text1.Container = Frame2
   Text1.Move 2400, 300, 600
   
   Command5.Caption = "Speed Test"
   Set Command5.Container = Frame2
   Command5.Move 4000, 260, 1100
   
   Label6.Caption = "Speed Test Status:"
   Set Label6.Container = Frame2
   Label6.Move 200, 800
   
   Label7.Caption = ""
   Label7.ForeColor = RGB(0, 0, 212)
   Set Label7.Container = Frame2
   Label7.Move 1800, 800

   Label8.Caption = "Bubble Sort time taken :"
   Set Label8.Container = Frame2
   Label8.Move 200, 1100
   
   Command6.Caption = "Skip"
   Set Command6.Container = Frame2
   Command6.Move 4000, 1050, 1100, 305

   Label9.Caption = "Selection Sort time taken :"
   Set Label9.Container = Frame2
   Label9.Move 200, 1400

   Command7.Caption = "Skip"
   Set Command7.Container = Frame2
   Command7.Move 4000, 1350, 1100, 305
   
   Label10.Caption = "Shell Sort time taken :"
   Set Label10.Container = Frame2
   Label10.Move 200, 1700

   Label11.Caption = "Quick Sort time taken :"
   Set Label11.Container = Frame2
   Label11.Move 200, 2000
      
  'FRAME 3 CONTROLS .......
   With Frame3
      .Caption = "Iteration Comparison"
      .Move 5525, 2000, 2700, 2550
   End With

   Label12.Caption = ""
   Set Label12.Container = Frame3
   Label12.Move 200, 1100
      
   Label13.Caption = ""
   Set Label13.Container = Frame3
   Label13.Move 200, 1400
   
   Label14.Caption = ""
   Set Label14.Container = Frame3
   Label14.Move 200, 1700

   Label15.Caption = ""
   Set Label15.Container = Frame3
   Label15.Move 200, 2000
   
   Label16.Caption = ""
   Set Label16.Container = Frame3
   Label16.Move 200, 2170
   
  'Exit button and final form setup .......
   Command8.Caption = "Exit"
   Command8.Width = 1600
   Command8.Move (Frame3.Left + Frame3.Width) - Command8.Width, (Frame2.Top + Frame2.Height) + 100
   
   Me.Height = Frame1.Height + Frame2.Height + 1500
   Me.Caption = "VBnet Sorting Comparison Demo - Bubble/Selection/Shell/Quicksort"
   
   Timer1.Interval = 1000
   Timer1.Enabled = False
   
End Sub


Private Sub Command1_Click()

  'Build an array of 30 random numbers and print
  'values to the screen. Then pass array to sort
  'proc and display the result.
   Dim nArray(0 To 30) As Long
   Dim cnt As Long
   Dim buff As String
   
  'fill an array with random numbers and display
   For cnt = LBound(nArray) To UBound(nArray)
      nArray(cnt) = Int(Rnd * 12) + 1
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label3.Caption = buff

   Call BubbleSortNumbers(nArray)
       
  'rebuild buff string and display
   buff = ""
   For cnt = LBound(nArray) To UBound(nArray)
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label4.Caption = buff
   
End Sub


Private Sub Command2_Click()

   Dim nArray(0 To 30) As Long
   Dim cnt As Long
   Dim buff As String
   
  'fill an array with random numbers and display
   For cnt = LBound(nArray) To UBound(nArray)
      nArray(cnt) = Int(Rnd * 12) + 1
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label3.Caption = buff
   
   Call SelectionSortNumbers(nArray)
   
  'rebuild buff string and display
   buff = ""
   For cnt = LBound(nArray) To UBound(nArray)
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label4.Caption = buff

End Sub


Private Sub Command3_Click()

   Dim nArray(0 To 30) As Long
   Dim cnt As Long
   Dim buff As String
   
  'fill an array with random numbers and display
   For cnt = LBound(nArray) To UBound(nArray)
      nArray(cnt) = Int(Rnd * 12) + 1
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label3.Caption = buff
   
   Call ShellSortNumbers(nArray)
   
  'rebuild buff string and display
   buff = ""
   For cnt = LBound(nArray) To UBound(nArray)
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label4.Caption = buff
   
End Sub


Private Sub Command4_Click()

   Dim nArray(0 To 30) As Long
   Dim cnt As Long
   Dim buff As String
   
  'fill an array with random numbers and display
   For cnt = LBound(nArray) To UBound(nArray)
      nArray(cnt) = Int(Rnd * 12) + 1
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label3.Caption = buff
   
   QSCallCnt = 0
   QSSwaps = 0
   Call QuickSortNumbers(nArray, 0, UBound(nArray))
   
  'rebuild buff string and display
   buff = ""
   For cnt = LBound(nArray) To UBound(nArray)
      buff = buff & "  " & nArray(cnt)
   Next cnt
   Label4.Caption = buff
   
End Sub


Private Sub Command5_Click()

   Dim cnt As Long

  'the main array of random numbers
   ReDim varray(0 To CLng(Text1.Text - 1)) As Long
   
  'copies of the array for each routine
   Dim vTemp1 As Variant
   Dim vTemp2 As Variant
   Dim vTemp3 As Variant
   
   Frame1.Enabled = False
   Label7.Caption = "Building array of " & Text1.Text & " elements ........."
   
   For cnt = LBound(varray) To UBound(varray)
      varray(cnt) = Int(Rnd * 100) + 1
   Next cnt
   
   vTemp1 = varray
   vTemp2 = varray
   vTemp3 = varray
   
  '---------------------------------------------------------------------------
   Label7.Caption = "Performing Bubble Sort ......"
   
   sortMethod = 1
   tmrCounter = 0
   SkipFlag = False
   
   Command6.Enabled = True
   Timer1.Enabled = True
      Call BubbleSortNumbers(varray)
   Timer1.Enabled = False
   Command6.Enabled = False
   
   Label8.Caption = "Bubble Sort time taken : " & tmrCounter & " seconds"
  '---------------------------------------------------------------------------
   Label7.Caption = "Performing Selection Sort ......"
   sortMethod = 2
   tmrCounter = 0
   SkipFlag = False
   
   Command7.Enabled = True
   Timer1.Enabled = True
      Call SelectionSortNumbers(vTemp1)
   Timer1.Enabled = False
   Command7.Enabled = False
   
   Label9.Caption = "Selection Sort time taken : " & tmrCounter & " seconds"
  '---------------------------------------------------------------------------
   Label7.Caption = "Performing Shell Sort ......"
   sortMethod = 3
   tmrCounter = 0
   
   Timer1.Enabled = True
      Call ShellSortNumbers(vTemp2)
   Timer1.Enabled = False
   
   Label10.Caption = "Shell Sort time taken : " & tmrCounter & " seconds"
  '---------------------------------------------------------------------------
   Label7.Caption = "Performing Quick Sort ......"
   sortMethod = 4
   tmrCounter = 0
   
   Timer1.Enabled = True
      Call QuickSortNumbers(vTemp3, 0, UBound(vTemp3))
   Timer1.Enabled = False
   
   Label11.Caption = "Quick Sort time taken : " & tmrCounter & " seconds"
  '---------------------------------------------------------------------------
   
   Label7.Caption = "Speed Test Complete."
   Frame1.Enabled = True

End Sub


Private Sub Command6_Click()

    SkipFlag = True

End Sub


Private Sub Command7_Click()

  SkipFlag = True

End Sub


Private Sub Command8_Click()

   Unload Me
   
End Sub


Private Sub Timer1_Timer()

   tmrCounter = tmrCounter + 1
   
   Select Case sortMethod
      Case 1
         Label8.Caption = "Bubble Sort time taken : " & tmrCounter & " seconds"
      Case 2
         Label9.Caption = "Selection Sort time taken : " & tmrCounter & " seconds"
      Case 3
         Label10.Caption = "Shell Sort time taken : " & tmrCounter & " seconds"
      Case 4
         Label11.Caption = "Quick Sort time taken : " & tmrCounter & " seconds"
      Case Else
   End Select
   
End Sub


Private Sub BubbleSortNumbers(varray As Variant)
   
   Dim cnt1 As Long
   Dim cnt2 As Long
   Dim tmp As Long
   Dim counter As Long
   
   Label12.Caption = "Working..."
   
   For cnt1 = UBound(varray) To LBound(varray) Step -1

      For cnt2 = LBound(varray) + 1 To cnt1
      
      If varray(cnt2 - 1) > varray(cnt2) Then
         tmp = varray(cnt2 - 1)
         varray(cnt2 - 1) = varray(cnt2)
         varray(cnt2) = tmp
      
        '-----------------------------
        'Required for the speed Test;
        'comment out for real use
         counter = counter + 1
         DoEvents
         If SkipFlag Then Exit For
        '----------------------------
      
      End If
      
      Next cnt2

   Next cnt1

   Label12.Caption = "Elements swapped : " & counter

End Sub


Private Sub QuickSortNumbers(varray As Variant, inLow As Long, inHigh As Long)

  'varray()  The varray to sort
  'inLow     First element of varray to start sort
  'inHigh    Last element of varray to start sort

  '----------------------------------------------------
  'update the call count label; comment out for real use
   QSCallCnt = QSCallCnt + 1
  '----------------------------------------------------

   Dim pivot As Long
   
   Dim tmpSwap As Long
   Dim tmpLow As Long
   Dim tmpHigh As Long
   
   tmpLow = inLow
   tmpHigh = inHigh
   pivot = varray((inLow + inHigh) / 2)

   While (tmpLow <= tmpHigh)
   
      While (varray(tmpLow) < pivot And tmpLow < inHigh)
         tmpLow = tmpLow + 1
      Wend
   
      While (pivot < varray(tmpHigh) And tmpHigh > inLow)
         tmpHigh = tmpHigh - 1
      Wend

      If (tmpLow <= tmpHigh) Then
         tmpSwap = varray(tmpLow)
         varray(tmpLow) = varray(tmpHigh)
         varray(tmpHigh) = tmpSwap
         tmpLow = tmpLow + 1
         tmpHigh = tmpHigh - 1

        '----------------------------------------------------
        'update the swap count label ; comment out for real use
         QSSwaps = QSSwaps + 1
        '----------------------------------------------------
      End If

   Wend
   
   If (inLow < tmpHigh) Then QuickSortNumbers varray, inLow, tmpHigh
   If (tmpLow < inHigh) Then QuickSortNumbers varray, tmpLow, inHigh
   
   Label15.Caption = "Sub was called : " & QSCallCnt & " times"
   Label16.Caption = "Elements Swapped : " & QSSwaps

End Sub


Private Sub SelectionSortNumbers(varray As Variant)

   Dim cnt1 As Long
   Dim cnt2 As Long
   Dim nMin As Long
   Dim tmp As Long
   Dim counter As Long
   
   Label13.Caption = "Working..."

   For cnt1 = LBound(varray) To UBound(varray) - 1

      nMin = cnt1

      For cnt2 = (cnt1 + 1) To UBound(varray)

         If varray(cnt2) < varray(nMin) Then
            nMin = cnt2
           '----------------------------------------------------
           'comment out for real use
           'update the iterations label
            counter = counter + 1
           '----------------------------------------------------
         End If

          '----------------------------------------------------
          'Required to enable abort of speed Test;
          'comment out for real use
           DoEvents
           If SkipFlag Then Exit For
          '----------------------------------------------------

      Next cnt2

      tmp = varray(nMin)
      varray(nMin) = varray(cnt1)
      varray(cnt1) = tmp

   Next cnt1

   Label13.Caption = "Elements swapped : " & counter

End Sub


Private Sub ShellSortNumbers(varray As Variant)

   Dim cnt As Long
   Dim tmp As Long
   Dim nHold As Long
   Dim nHValue As Long
   Dim counter As Long
   
   Label14.Caption = "Working..."
   
   nHValue = LBound(varray)
   
   Do
      nHValue = 3 * nHValue + 1
   Loop Until nHValue > UBound(varray)
   
   Do
      nHValue = nHValue / 3

      For cnt = nHValue + LBound(varray) To UBound(varray)

         tmp = varray(cnt)
         nHold = cnt

         Do While varray(nHold - nHValue) > tmp
            varray(nHold) = varray(nHold - nHValue)
            nHold = nHold - nHValue

          '----------------------------------------------------
           'Required for the speed Test; comment out for real use
           'update the iterations label
            counter = counter + 1
            DoEvents
           '----------------------------------------------------

            If nHold < nHValue Then Exit Do

         Loop

         varray(nHold) = tmp

      Next cnt

   Loop Until nHValue = LBound(varray)

   Label14.Caption = "Elements swapped : " & counter

End Sub
 Comments
None.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter