Функция Replace

[coder]

Есть ли аналог функции Replace (функция VB6, сам я программирую на VB5, она мне не доступна) в API или как по другому можно БЫСТРО заменить символ(ы) в длинной строке (1 миллион символов), не пользуясь склеиванием начала и конца строки после каждой замена (слишком МЕДЛЕННО)?

[skiperski]

Если заменяемая (Find) и замещающая (Replace) строки равны по длине, то можно пользоваться конструкцией:

Код: Выделить всё

p = InStr(1, Expression, Find)
Mid$(Expression, p) = Replace

[coder]

Если заменяемая (Find) и замещающая (Replace) строки равны по длине, то можно пользоваться конструкцией:

Код: Выделить всё

p = InStr(1, Expression, Find)
Mid$(Expression, p) = Replace

Нужно именно разной длинны

[skiperski]

Включаем программу логического мышления!

Я в волшебном шаре вижу, что для тестирования нам понадобится функция генерации строки определённой длины:

Код: Выделить всё

Public Function genString(ByVal Length As Long) As String
   
    Dim s As String
   
    s = "123456789_"
   
    Do While (Len(s) < Length)
        s = s & s
    Loop
    genString = Left$(s, Length)
   
End Function

Первое что приходит в голову - стандартная конкатенация:

Код: Выделить всё

Public Function Replace1(ByVal Expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
   
    Dim l As Long
    Dim p As Long
    Dim s As String
   
    l = Len(Find)
    If (l = 0) Then
        Replace1 = Expression
        Exit Function
    End If
   
    s = vbNullString
    p = InStr(1, Expression, Find, Compare)
    Do While (p)
        s = s & Left$(Expression, p - 1) & Replace
        Expression = Mid$(Expression, p + l)
        p = InStr(1, Expression, Find, Compare)
    Loop
    Replace1 = s & Expression
   
End Function

Но! Функция InStr() использует параметр Start. Тогда, усложнив код, можно исключить модификацию строки Expression.

Код: Выделить всё

Public Function Replace2(ByVal Expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
   
    Dim l As Long
    Dim p1 As Long
    Dim p2 As Long
    Dim s As String
   
    l = Len(Find)
    If (l = 0) Then
        Replace2 = Expression
        Exit Function
    End If
   
    s = vbNullString
    p1 = 1
    p2 = InStr(p1, Expression, Find, Compare)
    Do While (p2)
        s = s & Mid$(Expression, p1, p2 - p1) & Replace
        p1 = p2 + l
        p2 = InStr(p1, Expression, Find, Compare)
    Loop
    Replace2 = s & Mid$(Expression, p1)
   
End Function

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

Код: Выделить всё

Public Function test1(ByVal Length As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim s0$, s1$, s2$
    Dim t0!, t1!, t2!
    Dim Expression$
   
    Expression = genString(Length)
   
    t0 = Timer()
    s0 = VBA.Replace(Expression, Find, Replace)
    t0 = Timer() - t0
   
    t1 = Timer()
    s1 = Replace1(Expression, Find, Replace)
    t1 = Timer() - t1
   
    t2 = Timer()
    s2 = Replace2(Expression, Find, Replace)
    t2 = Timer() - t2
   
    Debug.Print s0 = s1, s1 = s2, s2 = s0
    Debug.Print t0, t1, t2
    Debug.Print 1, t1 / t0, t2 / t0
   
End Function

Immediate:

Код: Выделить всё

?test1(100000, "456", "&&&&&&")
True          True          True
0,014875      4,14025       2,905625
1             278,3362      195,3361

?test1(100000, "456", "&&&")
True          True          True
0,015375      2,26475       1,421125
1             147,3008      92,43089

?test1(100000, "456", "&")
True          True          True
0,015125      1,4215        0,718625
1             93,98347      47,5124

В результате нехитрого тестирования получаем, что функция Replace2() выполняется примерно в полтора-два раза быстрее чем Replace1(), но в десятки и сотни раз медленнее чем стандарная VBA.Replace()

Далее в качестве базовой функции берём Replace2(). Зная о том, что Mid$() работает много быстрее конкатенации, усложняем алгоритм, надеясь на хоть какой-нибудь выигрыш во времени.

Код: Выделить всё

Public Function Replace3(ByVal Expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
   
    Dim l As Long
    Dim lenR As Long
    Dim p1 As Long
    Dim p2 As Long
    Dim p21 As Long
    Dim s As String
   
    l = Len(Find)
    If (l = 0) Then
        Replace3 = Expression
        Exit Function
    End If
   
    lenR = Len(Replace)
    If (lenR > l) Then
        s = Space$(Len(Expression) + (Len(Expression) \ l) * (lenR - l))
    Else
        s = Space$(Len(Expression))
    End If
   
    p21 = 1
    p1 = 1
    p2 = InStr(p1, Expression, Find, Compare)
    Do While (p2)
        Mid$(s, p21) = Mid$(Expression, p1, p2 - p1)
        p21 = p21 + p2 - p1
        Mid$(s, p21) = Replace
        p21 = p21 + lenR
        p1 = p2 + l
        p2 = InStr(p1, Expression, Find, Compare)
    Loop
    Mid$(s, p21) = Mid$(Expression, p1)
    p21 = p21 + Len(Mid$(Expression, p1))
    s = Left$(s, p21 - 1)
    Replace3 = s
   
End Function

Проверяем что получилось

Код: Выделить всё

Public Function test2(ByVal Length As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim s0$, s2$, s3$
    Dim t0!, t2!, t3!
    Dim Expression$
   
    Expression = genString(Length)
   
    t0 = Timer()
    s0 = VBA.Replace(Expression, Find, Replace)
    t0 = Timer() - t0
   
    t2 = Timer()
    s2 = Replace2(Expression, Find, Replace)
    t2 = Timer() - t2
   
    t3 = Timer()
    s3 = Replace3(Expression, Find, Replace)
    t3 = Timer() - t3
   
    Debug.Print s0 = s2, s2 = s3, s3 = s0
    Debug.Print t0, t2, t3
    Debug.Print 1, t2 / t0, t3 / t0
   
End Function

Immediate:

Код: Выделить всё

?test2(100000, "456", "&&&&&&")
True          True          True
0,0155        2,936875      0,015375
1             189,4758      0,9919356

?test2(100000, "456", "&&&")
True          True          True
0,014875      1,46825       0,0155
1             98,70588      1,042017

?test2(100000, "456", "&")
True          True          True
0,015         0,890375      0,01475
1             59,35834      0,9833333

!!!!!! Вау!!! Ёпрст!!! Результат превзошёл все ожидания! Наша функция выполняется быстрее стандарной или почти так же! Но! Мы же помним о замене строк одинаковой длины. И не останавливаясь на достигнутом, ещё раз усложняем алгоритм, обрабатывая исключительную ситуацию совпадения длины замещаемой и замещающей строк.

Код: Выделить всё

Public Function Replace3_1(ByVal Expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As String
   
    Dim l As Long
    Dim lenR As Long
    Dim p1 As Long
    Dim p2 As Long
    Dim p21 As Long
    Dim s As String
   
    l = Len(Find)
    If (l = 0) Then
        Replace3_1 = Expression
        Exit Function
    End If
   
    lenR = Len(Replace)
    If (lenR = l) Then
        p1 = 1
        p2 = InStr(p1, Expression, Find, Compare)
        Do While (p2)
            Mid$(Expression, p1) = Mid$(Expression, p1, p2 - p1)
            Mid$(Expression, p2) = Replace
            p1 = p2 + l
            p2 = InStr(p1, Expression, Find, Compare)
        Loop
        Replace3_1 = Expression
        Exit Function
    ElseIf (lenR > l) Then
        s = Space$(Len(Expression) + (Len(Expression) \ l) * (lenR - l))
    Else
        s = Space$(Len(Expression))
    End If
   
    p21 = 1
    p1 = 1
    p2 = InStr(p1, Expression, Find, Compare)
    Do While (p2)
        Mid$(s, p21) = Mid$(Expression, p1, p2 - p1)
        p21 = p21 + p2 - p1
        Mid$(s, p21) = Replace
        p21 = p21 + lenR
        p1 = p2 + l
        p2 = InStr(p1, Expression, Find, Compare)
    Loop
    Mid$(s, p21) = Mid$(Expression, p1)
    p21 = p21 + Len(Mid$(Expression, p1))
    s = Left$(s, p21 - 1)
    Replace3_1 = s
   
End Function

Быстренько тестируем

Код: Выделить всё

Public Function test3(ByVal Length As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim s0$, s3$, s4$
    Dim t0!, t3!, t4!
    Dim Expression$
   
    Expression = genString(Length)
   
    t0 = Timer()
    s0 = VBA.Replace(Expression, Find, Replace)
    t0 = Timer() - t0
   
    t3 = Timer()
    s3 = Replace3(Expression, Find, Replace)
    t3 = Timer() - t3
   
    t4 = Timer()
    s4 = Replace3_1(Expression, Find, Replace)
    t4 = Timer() - t4
   
    Debug.Print s0 = s3, s3 = s4, s4 = s0
    Debug.Print t0, t3, t4
    Debug.Print 1, t3 / t0, t4 / t0
   
End Function

Длины строки в сто тысяч уже не достаточно для проверки достоверности результата поэтому, внимание!!!, увеличиваем длину до миллиона.

Код: Выделить всё

?test3(1000000, "456", "&&&&&&")
True          True          True
0,281         0,12475       0,12475
1             0,4439502     0,4439502

?test3(1000000, "456", "&&&")
True          True          True
0,29625       0,109375      0,078
1             0,3691983     0,2632912

?test3(1000000, "456", "&")
True          True          True
0,280625      0,109375      0,109
1             0,389755      0,3884187

Да, упорство и труд - всё перетрут! Как и ожидалось, функция работает при замене строк одинаковой длины быстрее! и почти в три раза быстрее стандарной!!! А если ещё оптимизировать функцию InStr()? Тогда не в два-три раза, а, быть может, в четыре-пять можно енто дело ускорить?

Вот так, решая совершенно левую задачу для уже почти мёртвой версии языка, получили результат превосходящий по скорости стандарные функции. Программистам в MS ещё есть чему поучиться.

ЗЫ: Гайдар, этот топик тянет на статью. Можешь его смело публиковать, я даже не обижусь.

[skiperski]

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

Код: Выделить всё

Public Function test1_1(ByVal Count As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim n As Long
    Dim s0$, s1$, s2$
    Dim t0!, t1!, t2!
    Dim Expression$, i&
   
    Expression = genString(100)
   
    t0 = Timer()
    For i = 1 To Count
        s0 = VBA.Replace(Expression, Find, Replace)
    Next
    t0 = Timer() - t0
   
    t1 = Timer()
    For i = 1 To Count
        s1 = Replace1(Expression, Find, Replace)
    Next
    t1 = Timer() - t1
   
    t2 = Timer()
    For i = 1 To Count
        s2 = Replace2(Expression, Find, Replace)
    Next
    t2 = Timer() - t2
   
    Debug.Print s0 = s1, s1 = s2, s2 = s0
    Debug.Print t0, t1, t2
    Debug.Print 1, t1 / t0, t2 / t0
   
End Function

Public Function test2_1(ByVal Count As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim s0$, s2$, s3$
    Dim t0!, t2!, t3!
    Dim Expression$, i&
   
    Expression = genString(100)
   
    t0 = Timer()
    For i = 1 To Count
        s0 = VBA.Replace(Expression, Find, Replace)
    Next
    t0 = Timer() - t0
   
    t2 = Timer()
    For i = 1 To Count
        s2 = Replace2(Expression, Find, Replace)
    Next
    t2 = Timer() - t2
   
    t3 = Timer()
    For i = 1 To Count
        s3 = Replace3(Expression, Find, Replace)
    Next
    t3 = Timer() - t3
   
    Debug.Print s0 = s2, s2 = s3, s3 = s0
    Debug.Print t0, t2, t3
    Debug.Print 1, t2 / t0, t3 / t0
   
End Function

Public Function test3_1(ByVal Count As Long, ByVal Find As String, ByVal Replace As String)
   
    Dim s0$, s3$, s4$
    Dim t0!, t3!, t4!
    Dim Expression$, i&
   
    Expression = genString(100)
   
    t0 = Timer()
    For i = 1 To Count
        s0 = VBA.Replace(Expression, Find, Replace)
    Next
    t0 = Timer() - t0
   
    t3 = Timer()
    For i = 1 To Count
        s3 = Replace3(Expression, Find, Replace)
    Next
    t3 = Timer() - t3
   
    t4 = Timer()
    For i = 1 To Count
        s4 = Replace3_1(Expression, Find, Replace)
    Next
    t4 = Timer() - t4
   
    Debug.Print s0 = s3, s3 = s4, s4 = s0
    Debug.Print t0, t3, t4
    Debug.Print 1, t3 / t0, t4 / t0
   
End Function

Immediate:

Код: Выделить всё

?test3_1(100000, "456", "&&&&&&")
True          True          True
0,76475       1,093125      1,093375
1             1,429389      1,429716

?test3_1(100000, "456", "&&&")
True          True          True
0,796         1,078125      0,828
1             1,354428      1,040201

?test3_1(100000, "456", "&")
True          True          True
0,780875      1,077625      1,0935
1             1,380022      1,400352

?test2_1(100000, "456", "&&&&&&")
True          True          True
0,78125       1,218         1,09325
1             1,55904       1,39936

?test2_1(100000, "456", "&&&")
True          True          True
0,781125      1,233875      1,0625
1             1,579613      1,360218

?test2_1(100000, "456", "&")
True          True          True
0,780375      1,203125      1,062
1             1,541727      1,360884

?test1_1(100000, "456", "&&&&&&")
True          True          True
0,781         1,37475       1,21875
1             1,760243      1,560499

?test1_1(100000, "456", "&&&")
True          True          True
0,796         1,374125      1,171125
1             1,726288      1,471263

?test1_1(100000, "456", "&")
True          True          True
0,781125      1,405875      1,171625
1             1,799808      1,49992

На строках малой длины все функции выполняются почти за одинаковое время и не на много, но всё же, примерно в полтора раза, медленнее чем стандарная. Где находится граница между малой и уже большой длиной - вопрос не из простых. Точнее даже не длина строки играет рояль, а количество замен, что мы заранее, в отличие от длины строки, знать не можем принципиально. Для каждой машины, возможно, это своя цифра. Но, согласитесь, решение в общем виде красивое.

[coder]

А это вам моя реализация, чуть-чуть доработанная и локализованная, работает немножко быстрее (заметно быстрее при равенству заменяемого и заменяющего). В дальнейшем хочу добавить ещё исключительный случай, когда заменяющее равно пустой строке

Код: Выделить всё

Public Function sЗаменаФрагментовСтроки_by_ChAko _
    (ByVal sСтрокаТребующаяПравки As String, _
    ByVal sЗаменяемаяПодстрока As String, _
    ByVal sПодстановка As String, _
    Optional ByVal lПозицияНачалаПоиска As Long = 1) As String

    Dim lДлинаСтрокиТребующейПравки As Long
    Dim lДлинаЗаменяемойПодстроки As Long
    Dim lДлинаПодстановки As Long
    Dim lПозицияНачалаЗаменяемойПодстроки As Long
    Dim lПозицияНачалаЗаменыВНовойСтроке  As Long
    Dim sНоваяСтрока As String
    Dim sОставшийсяНеЗаменяемыйХвост As String
    Dim lДлинаНеЗаменяемойЧасти As Long

' сбор данных
    lДлинаСтрокиТребующейПравки = Len(sСтрокаТребующаяПравки) - lПозицияНачалаПоиска + 1
    lДлинаЗаменяемойПодстроки = Len(sЗаменяемаяПодстрока)
    lДлинаПодстановки = Len(sПодстановка)
    sНоваяСтрока = vbNullString
   
' обработка ошибок
    If lДлинаЗаменяемойПодстроки > lДлинаСтрокиТребующейПравки Then
        sЗаменаФрагментовСтроки_by_ChAko = sСтрокаТребующаяПравки
        Exit Function
    End If
    If (lДлинаСтрокиТребующейПравки = 0) And _
        (lДлинаЗаменяемойПодстроки = 0) Then
        sЗаменаФрагментовСтроки_by_ChAko = sСтрокаТребующаяПравки
        Exit Function
    End If
   
    lПозицияНачалаЗаменяемойПодстроки = InStr(lПозицияНачалаПоиска, sСтрокаТребующаяПравки, sЗаменяемаяПодстрока)
   
' определяемся с длинной НовойСтроки
    If lДлинаПодстановки = lДлинаЗаменяемойПодстроки Then
    ' НоваяСтрока = СтрокаТребующаяПравки
   
        Do While (lПозицияНачалаЗаменяемойПодстроки <> 0)
        ' производим замену подстроки
            Mid$(sСтрокаТребующаяПравки, lПозицияНачалаЗаменяемойПодстроки) = sПодстановка
        ' определяем позицию следующего поиска
            lПозицияНачалаПоиска = lПозицияНачалаЗаменяемойПодстроки + lДлинаЗаменяемойПодстроки
        ' определяем позицию следующей замены
            lПозицияНачалаЗаменяемойПодстроки = InStr(lПозицияНачалаПоиска, sСтрокаТребующаяПравки, sЗаменяемаяПодстрока)
        Loop
   
        sЗаменаФрагментовСтроки_by_ChAko = sСтрокаТребующаяПравки
        Exit Function
    ElseIf lДлинаПодстановки > lДлинаЗаменяемойПодстроки Then
    ' НоваяСтрока > СтрокаТребующаяПравки
        If lПозицияНачалаПоиска > 1 Then
        ' замена нулей текстом, не подлежащим правке
            sНоваяСтрока = Space$(lДлинаСтрокиТребующейПравки + (lДлинаСтрокиТребующейПравки \ lДлинаЗаменяемойПодстроки + 1) * (lДлинаПодстановки - lДлинаЗаменяемойПодстроки) + lПозицияНачалаПоиска - 1)
            Mid(sНоваяСтрока, 1) = Mid(sСтрокаТребующаяПравки, 1, lПозицияНачалаПоиска - 1)
        Else
        ' поиск с начала
            sНоваяСтрока = Space$(lДлинаСтрокиТребующейПравки + (lДлинаСтрокиТребующейПравки \ lДлинаЗаменяемойПодстроки + 1) * (lДлинаПодстановки - lДлинаЗаменяемойПодстроки))
        End If
    Else
    ' НоваяСтрока < СтрокаТребующаяПравки
        If lПозицияНачалаПоиска > 1 Then
        ' замена нулей текстом, не подлежащим правке
            sНоваяСтрока = Space$(lДлинаСтрокиТребующейПравки + lПозицияНачалаПоиска - 1)
            Mid(sНоваяСтрока, 1) = Mid(sСтрокаТребующаяПравки, 1, lПозицияНачалаПоиска - 1)
        Else
            sНоваяСтрока = Space$(lДлинаСтрокиТребующейПравки)
        End If
    End If
   
    lПозицияНачалаЗаменыВНовойСтроке = lПозицияНачалаПоиска

' перебор всех найденных заменяемых подстрок
    Do While (lПозицияНачалаЗаменяемойПодстроки <> 0)
    ' вставляем не замняемую часть
        lДлинаНеЗаменяемойЧасти = lПозицияНачалаЗаменяемойПодстроки - lПозицияНачалаПоиска
        Mid$(sНоваяСтрока, lПозицияНачалаЗаменыВНовойСтроке) = Mid$(sСтрокаТребующаяПравки, lПозицияНачалаПоиска, lДлинаНеЗаменяемойЧасти)
        lПозицияНачалаЗаменыВНовойСтроке = lПозицияНачалаЗаменыВНовойСтроке + lДлинаНеЗаменяемойЧасти
    ' вставляем подстановку
        Mid$(sНоваяСтрока, lПозицияНачалаЗаменыВНовойСтроке) = sПодстановка
    ' позиция следующей встаки в НовойСтроке
        lПозицияНачалаЗаменыВНовойСтроке = lПозицияНачалаЗаменыВНовойСтроке + lДлинаПодстановки
        lПозицияНачалаПоиска = lПозицияНачалаЗаменяемойПодстроки + lДлинаЗаменяемойПодстроки
        lПозицияНачалаЗаменяемойПодстроки = InStr(lПозицияНачалаПоиска, sСтрокаТребующаяПравки, sЗаменяемаяПодстрока)
    Loop
   
' вставка оставшегося не заменяемого хвоста
    sОставшийсяНеЗаменяемыйХвост = Mid$(sСтрокаТребующаяПравки, lПозицияНачалаПоиска)
    Mid$(sНоваяСтрока, lПозицияНачалаЗаменыВНовойСтроке) = sОставшийсяНеЗаменяемыйХвост
   
' обрезание оставшихся нулей
    lПозицияНачалаЗаменыВНовойСтроке = lПозицияНачалаЗаменыВНовойСтроке + Len(sОставшийсяНеЗаменяемыйХвост)
    sНоваяСтрока = Left$(sНоваяСтрока, lПозицияНачалаЗаменыВНовойСтроке - 1)
   
    sЗаменаФрагментовСтроки_by_ChAko = sНоваяСтрока
End Function

[gaidar]

Гайдар, этот топик тянет на статью. Можешь его смело публиковать, я даже не обижусь.

Есть! Как прикажете, с Идеологом спорить не буду ,

[RayShade]

skiperski, у меня нет слов. Ты, как всегда, великолепен

[skiperski]

Есть! Как прикажете, с Идеологом спорить не буду ,

Только надо дооформить и причесать текст, и, собственно, выдумать тему. Потому как для сопроводиловки этого достаточно, но в качестве самостоятельной статьи - нет. Что-нибудь типа: "Исследование и анализ проблем оптимизации стандартных процессов замещения нерегулярных выражений в среде разработки MS Visual Basic, а так же демонстрация простейших методов и приёмов тестирования". Вроде бы неплохо: коротко и ясно.

ЗЫ: А когда это меня Идиотологом обозвать успели? Я и не заметил даже.

[gaidar]

Я уже кое-как статью обозвал - смотри на сайте в VB разделе.

А на счет идеолога, это к Егору. У меня звание такое, что мне не до таких мелочных проблем

[skiperski]

Я уже кое-как статью обозвал - смотри на сайте в VB разделе.

Ага, вижу. Только тогда надо и следующее сообщение туда приделать, где про длину строки.

А на счет идеолога, это к Егору. У меня звание такое, что мне не до таких мелочных проблем

Звиняйте, пан-товарищь-барин-тхе Lord, за таке малюсеньке та непотрiбне пытання.

[Taras2]

Есть ли аналог функции Replace (функция VB6, сам я программирую на VB5, она мне не доступна) в API или как по другому можно БЫСТРО заменить символ(ы) в длинной строке (1 миллион символов), не пользуясь склеиванием начала и конца строки после каждой замена (слишком МЕДЛЕННО)?

Может немного не в тему и поздно, но взгляни сюда: http://bbs.vbstreets.ru/viewtopic.php?t=3002&highlight=