Binaryworld - Count Sort, a special case of indexed sort ... [ VB -> Arrays ]

CountSort is yet another sort algorithm, which can be applied only under very particular conditions but that, when such conditions are met, turns to be the fastest of the lot. Count Sort can be used when the key is of Integer type, or when it is of Long type but the range of values is not too large.

The idea underlying the algorithm is that each key data can indirectly work an initial index for itself. The routine parses the original array determining its minimum and maximum value, then builds a temporary array of Long with one element for each possible value of the key. The routine parses the original array again, this time counting the occurrences of each distinct value. After this step, it is very easy to evaluate where each value has to go in the definitive, sorted array, and this can be accomplished in the third step. Here is the complete routine:

The most interesting detail on this sorting algorithm is that its total time is proportional to the number of items to be sorted, therefore is even more convenient than Quick Sort, whose processing time grows proportionally to N * Log2(N). When sorting 10,000 items, Count Sort is 2.5 faster than Quick Sort, and is about five times faster when sorting one hundred thousand values.

Click here to copy the following block

Sub NdxCountSortI(arr() As Integer, ndx() As Long, Optional ByVal numEls As _
  Variant)
  Dim index As Long
  Dim inverseOrder As Boolean
  Dim value As Integer
  Dim minValue As Integer
  Dim maxValue As Integer
  Dim saveCount As Integer
  Dim newIndex As Long

  ' account for optional arguments
  If IsMissing(numEls) Then numEls = UBound(arr)

  ' search min and max value
  minValue = arr(LBound(arr))
  maxValue = minValue
  For index = LBound(arr) To numEls
    value = arr(index)
    If value < minValue Then
      minValue = value
    ElseIf value > maxValue Then
      maxValue = value
    End If
  Next

  ' declare the temporary index arr
  ReDim Count(minValue To maxValue) As Long
  ' fill each item of the temporary arr with
  ' number of occurrences for that value
  For index = LBound(arr) To numEls
    value = arr(index)
    Count(value) = Count(value) + 1
  Next

  ' parse the count() array to replace the count
  ' value with the definitive position
  ' in the sorted array
  newIndex = LBound(ndx)
  For index = minValue To maxValue
    saveCount = Count(index)
    Count(index) = newIndex
    newIndex = newIndex + saveCount
  Next

  ' finally build the index
  For index = LBound(arr) To numEls
  ' get position of the item in the index
    newIndex = Count(arr(index))
    ' remember the original position
    ndx(newIndex) = index
    ' next time store value in subsequent item
    Count(arr(index)) = newIndex + 1
  Next
End Sub