Question

我在这里的工作正常，对于10行字节×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

在vb6中对阵列数组进行排序的更快方法

1 个答案: