Размышления о функции Replace

Дата публикации статьи: 21.12.2003 10:23

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

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


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 ещё есть чему поучиться.