Молниеносный StringBuilder

В процессе попытки создания сериализуемой структуры данных я обнаружил, что строю большие строки, которые становятся очень медленными, потому что VBA копирует строку каждый раз при выполнении конкатенации.

Чтобы облегчить это, обратившись к динамическому массиву и интерфейсу Java StringBuilder, я объединил unicode clsStringBuilder.

Это не очень большой кусок кода, но меня бы интересовали любые советы по поводу случаев, которые я, возможно, не рассматривал, неожиданное поведение при копировании, которое VBA может выполнять «за моей спиной», что я мог бы избегать или исправлять стиль кодирования (или его отсутствие).

Option Compare Database
Option Explicit

'******
'* v2 *
'******


Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal dst As Long, ByVal src As Long, ByVal Length As Long)

Private Const DEFAULT_CAPACITY As Long = &H10
Private m_currLen As Long
Private m_stringBuffer() As Byte

Private Sub Class_Initialize()
    ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY * 2) - 1) 'Each unicode character is 2 bytes
End Sub

Public Function Append(strString As String) As clsStringBuilder
On Error GoTo derp


    If m_currLen + LenB(strString) < UBound(m_stringBuffer) Then
        CopyMemory VarPtr(m_stringBuffer(m_currLen)), StrPtr(strString), LenB(strString)
    Else
        If m_currLen + LenB(strString) < UBound(m_stringBuffer) * 2 Then
            Expand
        Else
            Expand m_currLen + LenB(strString)
        End If
        CopyMemory VarPtr(m_stringBuffer(m_currLen)), StrPtr(strString), LenB(strString)
    End If
    m_currLen = m_currLen + LenB(strString)
    Set Append = Me
    Exit Function

derp:
    Stop
    Resume
End Function

Public Property Get Length() As Long
    Length = m_currLen / 2
End Property

Public Property Get Capacity() As Long
    Capacity = UBound(m_stringBuffer)
End Property

Private Sub Expand(Optional newSize As Long = 0)
    If newSize <> 0 Then
        ReDim Preserve m_stringBuffer(0 To newSize - 1)
    Else
        ReDim Preserve m_stringBuffer(0 To (UBound(m_stringBuffer) * 2) + 1)
    End If
End Sub

Public Function toString() As String
    toString = Mid(m_stringBuffer, 1, m_currLen / 2)
End Function

Вот тест:

Public Sub Main()
    Dim sb As clsStringBuilder
    Set sb = New clsStringBuilder
    Dim strString As String
    Dim i As Long
    Dim StartTime As Double

    'VBA String
    StartTime = MicroTimer()
    For i = 0 To 100000
        strString = strString + "Hello World;"
    Next
    Debug.Print "The VBA String took: " & Round(MicroTimer - StartTime, 3) & " seconds"

    'StringBuilder
    StartTime = MicroTimer()
    For i = 0 To 100000
        sb.Append "Hello World;"
    Next
    Debug.Print "The Stringbuilder took: " & Round(MicroTimer - StartTime, 3) & " seconds"

    'Are the strings the same?
    Debug.Print StrComp(strString, sb.toString, vbBinaryCompare)
End Sub

Вот функция Microsoft MicroTimer, которую можно найти здесь :

Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Function MicroTimer() As Double
'

' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0

' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
    getTickCount cyTicks1

' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
29 голосов | спросил Blackhawk 22 +04002014-10-22T23:02:03+04:00312014bEurope/MoscowWed, 22 Oct 2014 23:02:03 +0400 2014, 23:02:03

3 ответа


20

Мне это нравится, много. Это великолепно. Подобно объектам .NET String, строки VBA являются неизменяемыми, что означает, например, в .NET, когда "the quick brown fox" с "jumps over", а затем "the lazy dog", это 4 строки, которые были сгенерированы, и, таким образом, первая была скопирована 3 раза; класс VBA StringBuilder поэтому определенно приветствуется в любом наборе инструментов VBA!

Вот вам какой-то серьезный код. Давайте посмотрим.

Итак, вы вызвали класс clsStringBuilder. Я знаю, откуда вы пришли, но нет никакой реальной причины для этого венгерского префикса «cls» - я удалю его и вызову класс StringBuilder.

'******
'* v2 *
'******

Не беспокойтесь об этом. Я знаю, что управление версиями практически невозможно с VBA, но, тем не менее, нет необходимости в «версии» кода; действительно ли вы поддерживаете номер версии? Зачем беспокоиться? Просто удалите его, это бесполезный беспорядок.

Private Const DEFAULT_CAPACITY As Long = &H10

Почему не 16? Шестнадцатеричный 10 соответствует 16? Я думаю, что было бы более понятным использовать десятичную нотацию. Фактически эта емкость потенциально запутанна, особенно с учетом шестизначной нотации. Является ли &H10 количество байтов? Символы?

ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY * 2) - 1) 'Each unicode character is 2 bytes

А, тогда символы. Как насчет вызова константы DEFAULT_CHARACTER_CAPACITY? Nah, слишком долго .. и мне лично не нравится YELLCASE, я бы просто назвал его InitialCharacterCapacity, но я видел, как другие люди используют ВСЕ CAPS для констант - пока вы он работает:)

Кстати, это хороший комментарий, который у вас есть, но я бы не стал указывать символы «unicode»; он запутывается, когда сама среда IDE поддерживает только строки ANSI!

Мне не нравятся префиксы и сокращенные имена, поэтому m_currLen станет currentLength и m_stringBuffer станет stringBufffer или просто buffer.

На самом деле, поскольку currentLength находится в байтах, я бы назвал его currentByteLength, чтобы избежать вопросительных знаков, когда дело доходит до этого:

Public Property Get Length() As Long
    Length = m_currLen / 2
End Property

Public Function Append(strString As String) As clsStringBuilder

strString, действительно? Я больше не венгерский! Также вы должны знать, что параметры передаются ByRef по умолчанию - я бы изменил подпись на это:

Public Function Append(ByVal value As String) As StringBuilder

Обработка ошибок не является оптимальной - если что-то взрывается, вы поднимаете IDE для конечного пользователя, чтобы поцарапать голову и отладить ваш код! Это не готово к производству:

derp:
    Stop
    Resume

«derp» ничего не значит для меня - мне нравится следовать «шаблону», как это:

Public Sub Foo()
    On Error GoTo CleanFail

    'implementation

CleanExit:
    Exit Sub

CleanFail:
    'handle error
    Resume CleanExit
End Sub

Вы также можете убедиться, что Expand фактически не сокращает буфер. Я думаю. ;)

Наконец, я не уверен, что понимаю, почему toString не соответствует соглашению и называется в PascalCase, как каждый общедоступный метод - ToString будет более привлекательным.

Хорошая работа!

ответил Mathieu Guindon 22 +04002014-10-22T23:49:33+04:00312014bEurope/MoscowWed, 22 Oct 2014 23:49:33 +0400 2014, 23:49:33
14

Ваш StringBuilder довольно впечатляет :) ++ к предложениям Мата, кроме YELLCASE, который я на стороне RubberDuck ;)

Я думаю, что я обнаружил потенциальное переполнение памяти ( out of memory ). Вероятно, это вряд ли произойдет с кем-то, но эй ... Если вы обернете свой цикл другим циклом, то время выполнения VBA, похоже, не догонит счет и освобождение ссылок ... Ваш StringBuilder тоже чертовски быстро работать во время выполнения VBA;)

Пример:

For j = 0 To 1000
    Dim csb As New clsStringBuilder

    StartTime = MicroTimer()
    For i = 0 To 100000
        csb.Append "Hello World;"
    Next
Next

В какой-то момент это остановится в derp и вызовет out of memory ... AFAIC, вы ничего не можете сделать ... кроме того, что не позволяют людям как я, чтобы проверить ваш код; P jk!

Несколько других мелких вещей от меня:

â-¡Select Case быстрее, чем If-Else

â-¡Отдел более дорогой, чем дополнение & умножение

â-¡Множественное вычисление для получения одного и того же числа немного неэффективно. Если вам нужно получить значение Ubound(arr) 5 раз в течение одного if-else /select case , подумайте о сохранении этого числа в переменной.

â-¡ Mid$()ToString() ) должен быть немного быстрее, чем Mid()

â-¡Вероятно, более безопасный вариант использования & вместо + для конкатенации строк. ( ваш Main() )

Общая скорость кажется чуть-чуть быстрее с моими улучшениями - слишком тонкая? ;)

1000 тестов каждый

введите описание изображения здесь

Хорошо. Я просто изменил имя на StringBuilder и вот что я сделал с ним:

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
    (ByVal dst As Long, ByVal src As Long, ByVal Length As Long)

Private Const DEFAULT_CAPACITY As Long = 16
Private m_currLen As Long
Private m_stringBuffer() As Byte

Private Sub Class_Initialize()
    ReDim m_stringBuffer(0 To (DEFAULT_CAPACITY + DEFAULT_CAPACITY) - 1) 'Each unicode character is 2 bytes
End Sub

Public Function Append(strString As String) As StringBuilder
On Error GoTo derp

    Dim uBuffer As Long
    uBuffer = UBound(m_stringBuffer)

    Dim lengthB As Long
    lengthB = LenB(strString)

    Dim sPtr As Long
    sPtr = StrPtr(strString)

    Dim currLen As Long
    currLen = m_currLen + lengthB

    Select Case currLen
        Case Is < uBuffer
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
        Case Is < (uBuffer + uBuffer)
            Expand
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
        Case Else
            Expand currLen
            CopyMemory VarPtr(m_stringBuffer(m_currLen)), sPtr, lengthB
    End Select

    m_currLen = currLen
    Set Append = Me
    Exit Function

derp:
    Stop
    Resume
End Function

Public Property Get Length() As Long
    Length = m_currLen * 0.5
End Property

Public Property Get Capacity() As Long
    Capacity = UBound(m_stringBuffer)
End Property

Private Sub Expand(Optional newSize As Long = 0)
    Select Case newSize
        Case Is = 0
            ReDim Preserve m_stringBuffer(0 To (UBound(m_stringBuffer) + UBound(m_stringBuffer)) + 1)
        Case Else
            ReDim Preserve m_stringBuffer(0 To newSize - 1)
    End Select
End Sub

Public Function ToString() As String
    ToString = Mid$(m_stringBuffer, 1, m_currLen * 0.5)
End Function

Вы могли бы немного поиграть с Select Case, но я оставил его в состоянии, в котором я счастливс ...

m_stringBuffer(m_currLen) должен быть O(1) , поэтому нет необходимости хранить в переменной IMO

ответил 23 +04002014-10-23T16:43:17+04:00312014bEurope/MoscowThu, 23 Oct 2014 16:43:17 +0400 2014, 16:43:17
6

Использование CopyMemory на самом деле не нужно, вы можете добиться того же самого просто с помощью массивов. Код не только короче, но и быстрее.

Dim MyBuffer() As String
Dim MyCurrentIndex As Long
Dim MyMaxIndex As Long

Private Sub Class_Initialize()

    MyCurrentIndex = 0
    MyMaxIndex = 16
    ReDim MyBuffer(1 To MyMaxIndex)

End Sub

'Appends the given Text to this StringBuilder
Public Sub Append(Text As String)

    MyCurrentIndex = MyCurrentIndex + 1

    If MyCurrentIndex > MyMaxIndex Then
        MyMaxIndex = 2 * MyMaxIndex
        ReDim Preserve MyBuffer(1 To MyMaxIndex)
    End If
    MyBuffer(MyCurrentIndex) = Text

End Sub

'Returns the text in this StringBuilder
'Optional Parameter: Separator (default vbNullString) used in joining components
Public Function ToString(Optional Separator As String = vbNullString) As String

    If MyCurrentIndex > 0 Then
        ReDim Preserve MyBuffer(1 To MyCurrentIndex)
        MyMaxIndex = MyCurrentIndex
        ToString = Join(MyBuffer, Separator)
    End If

End Function
ответил Martin.Roller 8 FebruaryEurope/MoscowbWed, 08 Feb 2017 13:21:58 +0300000000pmWed, 08 Feb 2017 13:21:58 +030017 2017, 13:21:58

Похожие вопросы

Популярные теги

security × 330linux × 316macos × 2827 × 268performance × 244command-line × 241sql-server × 235joomla-3.x × 222java × 189c++ × 186windows × 180cisco × 168bash × 158c# × 142gmail × 139arduino-uno × 139javascript × 134ssh × 133seo × 132mysql × 132