Data Sorting in VB6
Contents
Sorting Algorithms
# Bogosort | |
# Bubble sort | # Very fast for lists that are almost sorted, slow sorting anything else. |
# Cocktail sort | |
# Comb sort | |
# Selection sort | # Simple and fast on small lists, slow on big lists |
# Insertion sort | # Also known as a Counting sort, see below. |
# Bucket sort | |
# Counting sort | # Extremely fast when the data is distributed over a small number range. Number only. Requires more memory. |
# Heapsort | |
# Smoothsort | |
# Merge sort | |
# Quicksort | |
# Binary tree sort | |
# Pigeonhole sort | |
# Radix sort | |
# Selectionsort | # simple to understand and fast on small (dozen items) list. not fast algorithm for large lists. |
# Shell sort |
Sorts -w- Examples
bubblesort
' min and max are the minimum and maximum indexes ' of the items that might still be out of order. Sub BubbleSort (List() As Long, ByVal min As Integer, _ ByVal max As Integer) Dim last_swap As Integer Dim i As Integer Dim j As Integer Dim tmp As Long ' Repeat until we are done. Do While min < max ' Bubble up. last_swap = min - 1 ' For i = min + 1 To max i = min + 1 Do While i <= max ' Find a bubble. If List(i - 1) > List(i) Then ' See where to drop the bubble. tmp = List(i - 1) j = i Do List(j - 1) = List(j) j = j + 1 If j > max Then Exit Do Loop While List(j) < tmp List(j - 1) = tmp last_swap = j - 1 i = j + 1 Else i = i + 1 End If Loop ' Update max. max = last_swap - 1 ' Bubble down. last_swap = max + 1 ' For i = max - 1 To min Step -1 i = max - 1 Do While i >= min ' Find a bubble. If List(i + 1) < List(i) Then ' See where to drop the bubble. tmp = List(i + 1) j = i Do List(j + 1) = List(j) j = j - 1 If j < min Then Exit Do Loop While List(j) > tmp List(j + 1) = tmp last_swap = j + 1 i = j - 1 Else i = i - 1 End If Loop ' Update min. min = last_swap + 1 Loop End Sub
quicksort (and remove duplicates)
This program sorts a list using a standard quicksort algorithm. See the code for how the algorithm works.
Then if you have the Remove Dupes option selected, the program removes duplicates. It scans through the sorted array, comparing each item to the one before it. If the item is different, it copies the item into a new array.
Public Function RemoveDups(strings() As String) As String() Dim old_i As Integer Dim last_i As Integer Dim result() As String ' Make the result array. ReDim result(1 To UBound(strings)) ' Copy the first item into the result array. result(1) = strings(1) ' Copy the other items last_i = 1 For old_i = 2 To UBound(strings) If result(last_i) <> strings(old_i) Then last_i = last_i + 1 result(last_i) = strings(old_i) End If Next old_i ' Remove unused entries from the result array. ReDim Preserve result(1 To last_i) ' Return the result array. RemoveDups = result End Function
Quicksort is a fine general purpose sorting algorithm. For different kinds of data, however, it may not be the fastest or the best. For example, it has trouble sorting lists that contain many duplicate values and the algorithm countingsort is much faster at sorting numeric data.
- Keep in mind that you cannot use countingsort to sort strings.
countingsort
Countingsort does not use comparisons. The items to sort must be integers, and this sort works best with a limited or defined range. A range across 1000 will work well, a range across 100,000 will not.
Sub Countingsort (List() As Long, sorted_list() As Long, _ min As Integer, max As Integer, min_value As Long, _ max_value As Long) Dim counts() As Integer Dim i As Integer Dim this_count As Integer Dim next_offset As Integer ' Create the Counts array. ReDim counts(min_value To max_value) ' Count the items. For i = min To max counts(List(i)) = counts(List(i)) + 1 Next i ' Convert the counts into offsets. next_offset = min For i = min_value To max_value this_count = counts(i) counts(i) = next_offset next_offset = next_offset + this_count Next i ' Place the items in the sorted array. For i = min To max sorted_list(counts(List(i))) = List(i) counts(List(i)) = counts(List(i)) + 1 Next i End Sub
selectionsort
Sub Selectionsort (List() As Long, min As Integer, _ max As Integer) Dim i As Integer Dim j As Integer Dim best_value As Long Dim best_j As Integer For i = min To max - 1 best_value = List(i) best_j = i For j = i + 1 To max If List(j) < best_value Then best_value = List(j) best_j = j End If Next j List(best_j) = List(i) List(i) = best_value Next i End Sub