例如,我这里的数据适用于 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
最佳答案
其中最慢的一步是循环中逐字节复制。我会利用 RtlMoveMemory API 调用(通常称为 CopyMemory)。这会进行 block 内存复制,速度要快得多。我还声明了一个模块级数组来充当行交换中的临时缓冲区。您可能可以合并下面的两个过程,使其独立:
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
关于sorting - 在 vb6 中对数组的数组进行排序的更快方法,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/12172153/