sorting - 在 vb6 中对数组进行排序的更快方法

Question

例如，我在这里所拥有的数据适用于 10 行字节 x 10 列字节 = 100 个元素的数据。但是现在我在 256 行字节 x 256 列字节 = 65536 个元素上进行了尝试，并且按照正确的字典顺序对行进行排序大约需要 30 分钟。无论如何要优化此功能，因此最多可能需要 5 秒才能完成。

我知道我必须使用其他一些排序算法，但我无法真正弄清楚该怎么做。

Function SortArrayOfArraysLexicoGraphically(ByRef data() As Byte) As Byte()
Dim lexicoGraphicalIndexes() As Byte

Dim dataSize As Long
dataSize = UBound(data) + 1
Dim squareRootMinusOne As Integer
Dim squareRoot As Integer
squareRoot = Sqr(dataSize)
squareRootMinusOne = squareRoot - 1

ReDim lexicoGraphicalIndexes(squareRootMinusOne)

Dim columnStart As Long
Dim row As Long
Dim column As Long
Dim rowSwapped As Boolean

For columnStart = 0 To UBound(lexicoGraphicalIndexes)
    lexicoGraphicalIndexes(columnStart) = columnStart
Next columnStart

'start column from the last element from the row and go backwards to first element in that row.
For columnStart = squareRootMinusOne To 0 Step -1
    Do
        rowSwapped = False
        Do
             If data((row * squareRoot) + columnStart) > data(((row + 1) * squareRoot) + columnStart) Then

                'Swaps a full row byte by byte.
                For column = 0 To squareRootMinusOne
                    Call SwapBytes(data, (row * squareRoot) + column, ((row + 1) * squareRoot) + column)
                Next column
                Call SwapBytes(lexicoGraphicalIndexes, row, row + 1)
                rowSwapped = True
            End If
            row = row + 1
        Loop Until row > squareRootMinusOne - 1
        row = 0
    Loop Until rowSwapped = False
Next columnStart

'returns a byte array of sorted indexes.
SortArrayOfArraysLexicoGraphically = lexicoGraphicalIndexes
End Function

Public Sub SwapBytes(data() As Byte, firstIndex As Long, secondIndex As Long)
    Dim tmpFirstByte As Byte
    tmpFirstByte = data(firstIndex)
    data(firstIndex) = data(secondIndex)
    data(secondIndex) = tmpFirstByte
End Sub

Answer 1

其中缓慢的一步是循环中逐字节复制。我会利用 RtlMoveMemory API 调用（通常称为 CopyMemory）。这会进行块内存复制，速度要快得多。我还声明了一个模块级数组作为行交换中的临时缓冲区。您可能只需合并以下两个过程，使其独立：

Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal nCount As Long)

Private m_bytTemp() As Byte


Function SortArrayOfArraysLexicoGraphically2(ByRef data() As Byte) As Byte()

    Dim lexicoGraphicalIndexes() As Byte
    Dim dataSize As Long
    Dim squareRootMinusOne As Integer
    Dim squareRoot As Integer
    Dim columnStart As Long
    Dim row As Long
    Dim column As Long
    Dim rowSwapped As Boolean

    dataSize = UBound(data) + 1
    squareRoot = Sqr(dataSize)
    ReDim m_bytTemp(1 To squareRoot)
    squareRootMinusOne = squareRoot - 1
    ReDim lexicoGraphicalIndexes(squareRootMinusOne)

    For columnStart = 0 To UBound(lexicoGraphicalIndexes)
        lexicoGraphicalIndexes(columnStart) = columnStart
    Next columnStart

    'start column from the last element from the row and go backwards to first element in that row.
    For columnStart = squareRootMinusOne To 0 Step -1
        Do
            rowSwapped = False
            Do
                If data((row * squareRoot) + columnStart) > data(((row + 1) * squareRoot) + columnStart) Then
                    'Swaps a full row in a few copies.
                    SwapMultipleBytes data, (row * squareRoot), ((row + 1) * squareRoot), squareRoot
                    Call SwapBytes(lexicoGraphicalIndexes, row, row + 1)
                    rowSwapped = True
                End If
                row = row + 1
            Loop Until row > squareRootMinusOne - 1
            row = 0
        Loop Until rowSwapped = False
    Next columnStart

    'returns a byte array of sorted indexes.
    SortArrayOfArraysLexicoGraphically2 = lexicoGraphicalIndexes
End Function

Public Sub SwapMultipleBytes(ByRef data() As Byte, ByVal firstIndex As Long, ByVal secondIndex As Long, ByVal nCount As Long)

    CopyMemory VarPtr(m_bytTemp(1)), VarPtr(data(firstIndex)), nCount
    CopyMemory VarPtr(data(firstIndex)), VarPtr(data(secondIndex)), nCount
    CopyMemory VarPtr(data(secondIndex)), VarPtr(m_bytTemp(1)), nCount

End Sub