Data Sorting in VB6
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