ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Производительность StringReplace
5 сообщений из 5, страница 1 из 1
Производительность StringReplace
    #39800871
DmSer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
DmSer
Участник
Решил сравнить встроенную функцию StringReplace в Tokyo со своей реализацией FastStringReplace . И был приятно удивлён: современная реализация StringReplace очень быстрая, в большинстве случаях бьёт по скорости мой вариант, иногда в несколько раз.
Мы привыкли ругать слабую оптимизацию, тормозной rtl, однако прогресс всё же идёт, это радует.
...
Рейтинг: 0 / 0
13.04.2019, 10:03
| Ответить | Цитировать | Написать  
Производительность StringReplace
    #39800878
Miracle9
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Miracle9
Гость
DmSer, Интересная инфа, спасибо!
...
Рейтинг: 0 / 0
13.04.2019, 10:52
| Ответить | Цитировать | Написать  
Производительность StringReplace
    #39800892
haydegen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
haydegen
Гость
DmSerРешил сравнить встроенную функцию StringReplace в Tokyo со своей реализацией FastStringReplace . И был приятно удивлён: современная реализация StringReplace очень быстрая, в большинстве случаях бьёт по скорости мой вариант, иногда в несколько раз.
Мы привыкли ругать слабую оптимизацию, тормозной rtl, однако прогресс всё же идёт, это радует.



хм... а этот https://bitbucket.org/alex7691/delphi/src/ как в сравнении с Tokyo SR?
...
Рейтинг: 0 / 0
13.04.2019, 12:41
| Ответить | Цитировать | Написать  
Производительность StringReplace
    #39800894
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
rgreat
Участник
Сам сравни. :)

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
function StringReplace(const Source, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
  Str: string;
  xOldPattern: string;
  FoundPos: Integer;
  I, J: Integer;
  SourceIdx: Integer;
  DestIdx: Integer;
  LCharsToCopy: Integer;
  FindCount: Integer;
  PosArray: array of Integer;
  LenOP: Integer;
  LenNP: Integer;
  LenS: Integer;
  ArrLen: Integer;
  LPResult, LPSource, LPNewPattern: PChar;
  LReplaceAll: Boolean;
begin
  LenOP := Length(OldPattern);
  LenS := Length(Source);
  if (LenOP = 0) or (LenS = 0) then
    Exit(Source);

  if rfIgnoreCase in Flags then
  begin
    xOldPattern := AnsiUpperCase(OldPattern);
    LenOP := Length(xOldPattern);
    if SameStr(xOldPattern, AnsiLowerCase(OldPattern)) then // Special case, for example only symbols (+ - , * .....)
      Str := Source
    else
    begin
      Str := AnsiUpperCase(Source);
      LenS := Length(Str);
    end;
  end
  else
  begin
    xOldPattern := OldPattern;
    Str := Source;
  end;

  if Str.Length <> Source.Length then
  begin
    Result := '';
    I := Low(string);
    while I <= High(Source) do
    begin
      if string.Compare(Source, I - Low(string), OldPattern, 0, LenOP, True) = 0 then
      begin
        Result := Result + NewPattern;
        Inc(I, LenOP);
        if not (rfReplaceAll in Flags) then
        begin
          Result := Result + Source.Substring(I - Low(string), MaxInt);
          Break;
        end;
      end
      else
      begin
        Result := Result + Source[I];
        Inc(I);
      end;
    end;
  end
  else
  begin
    FoundPos := 1;
    FindCount := 0;
    ArrLen := 0;
    LReplaceAll := not (rfReplaceAll in Flags);
    repeat
      FoundPos := Pos(xOldPattern, Str, FoundPos);
      if FoundPos = 0 then
        Break;

      Inc(FindCount);
      if ArrLen < FindCount then
      begin
        if ArrLen = 0 then
          ArrLen := 32
        else
          ArrLen := ArrLen * 2;
        SetLength(PosArray, ArrLen);   // call SetLength less frequently makes a huge difference when replacing multiple occurrences
      end;
      PosArray[FindCount - 1] := FoundPos - 1; // Zero based array
      Inc(FoundPos, LenOP);
    until LReplaceAll;

    if FindCount > 0 then
    begin
      LenNP := Length(NewPattern);
      LPSource := Pointer(Source);           // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      LPNewPattern := Pointer(NewPattern);  // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      if LenNP = LenOP then
      begin                           // special case where Length(OldPattern) = Length(NewPattern)
        SetLength(Result, LenS);      // in this case, we can optimize it even further
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        Move(LPSource^, LPResult^, LenS * SizeOf(Char));
        if LenNP = 1 then
          for I := 0 to FindCount - 1 do
            LPResult[PosArray[I]] := LPNewPattern^
        else if LenNP <= 8 then
          for I := 0 to FindCount - 1 do
            for J := 0 to LenNP -1  do
              LPResult[PosArray[I] + J] := LPNewPattern[J]
        else
          for I := 0 to FindCount - 1 do
            Move(LPNewPattern^, LPResult[PosArray[I]], LenNP * SizeOf(Char));
      end
      else
      begin
        SetLength(Result, LenS + ((LenNP - LenOP) * FindCount));
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        SourceIdx := 0;
        DestIdx := 0;
        if LenNP = 0 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Inc(SourceIdx, LenOP);
          end
        else if LenNP = 1 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            LPResult[DestIdx] := LPNewPattern[0];
            Inc(DestIdx);
            Inc(SourceIdx, LenOP);
          end
        else
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Move(LPNewPattern^, LPResult[DestIdx], LenNP * SizeOf(Char));
            Inc(DestIdx, LenNP);
            Inc(SourceIdx, LenOP);
          end;

        LCharsToCopy := LenS - SourceIdx;
        if LCharsToCopy > 0 then
          Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
      end;
    end
    else
      Result := Source;
  end;
end;

...
Рейтинг: 0 / 0
13.04.2019, 12:47
| Ответить | Цитировать | Написать  
Производительность StringReplace
    #39800971
Фотография defecator
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
defecatorПривилегированный пользователь
Модератор форума
rgreatСам сравни. :)

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
function StringReplace(const Source, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
  Str: string;
  xOldPattern: string;
  FoundPos: Integer;
  I, J: Integer;
  SourceIdx: Integer;
  DestIdx: Integer;
  LCharsToCopy: Integer;
  FindCount: Integer;
  PosArray: array of Integer;
  LenOP: Integer;
  LenNP: Integer;
  LenS: Integer;
  ArrLen: Integer;
  LPResult, LPSource, LPNewPattern: PChar;
  LReplaceAll: Boolean;
begin
  LenOP := Length(OldPattern);
  LenS := Length(Source);
  if (LenOP = 0) or (LenS = 0) then
    Exit(Source);

  if rfIgnoreCase in Flags then
  begin
    xOldPattern := AnsiUpperCase(OldPattern);
    LenOP := Length(xOldPattern);
    if SameStr(xOldPattern, AnsiLowerCase(OldPattern)) then // Special case, for example only symbols (+ - , * .....)
      Str := Source
    else
    begin
      Str := AnsiUpperCase(Source);
      LenS := Length(Str);
    end;
  end
  else
  begin
    xOldPattern := OldPattern;
    Str := Source;
  end;

  if Str.Length <> Source.Length then
  begin
    Result := '';
    I := Low(string);
    while I <= High(Source) do
    begin
      if string.Compare(Source, I - Low(string), OldPattern, 0, LenOP, True) = 0 then
      begin
        Result := Result + NewPattern;
        Inc(I, LenOP);
        if not (rfReplaceAll in Flags) then
        begin
          Result := Result + Source.Substring(I - Low(string), MaxInt);
          Break;
        end;
      end
      else
      begin
        Result := Result + Source[I];
        Inc(I);
      end;
    end;
  end
  else
  begin
    FoundPos := 1;
    FindCount := 0;
    ArrLen := 0;
    LReplaceAll := not (rfReplaceAll in Flags);
    repeat
      FoundPos := Pos(xOldPattern, Str, FoundPos);
      if FoundPos = 0 then
        Break;

      Inc(FindCount);
      if ArrLen < FindCount then
      begin
        if ArrLen = 0 then
          ArrLen := 32
        else
          ArrLen := ArrLen * 2;
        SetLength(PosArray, ArrLen);   // call SetLength less frequently makes a huge difference when replacing multiple occurrences
      end;
      PosArray[FindCount - 1] := FoundPos - 1; // Zero based array
      Inc(FoundPos, LenOP);
    until LReplaceAll;

    if FindCount > 0 then
    begin
      LenNP := Length(NewPattern);
      LPSource := Pointer(Source);           // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      LPNewPattern := Pointer(NewPattern);  // We use a pointer cast to avoid the _UStrToPWChar call injected by the compiler
      if LenNP = LenOP then
      begin                           // special case where Length(OldPattern) = Length(NewPattern)
        SetLength(Result, LenS);      // in this case, we can optimize it even further
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        Move(LPSource^, LPResult^, LenS * SizeOf(Char));
        if LenNP = 1 then
          for I := 0 to FindCount - 1 do
            LPResult[PosArray[I]] := LPNewPattern^
        else if LenNP <= 8 then
          for I := 0 to FindCount - 1 do
            for J := 0 to LenNP -1  do
              LPResult[PosArray[I] + J] := LPNewPattern[J]
        else
          for I := 0 to FindCount - 1 do
            Move(LPNewPattern^, LPResult[PosArray[I]], LenNP * SizeOf(Char));
      end
      else
      begin
        SetLength(Result, LenS + ((LenNP - LenOP) * FindCount));
        LPResult := Pointer(Result);    // We use a pointer cast to avoid the uniquestring call injected by the compiler
        SourceIdx := 0;
        DestIdx := 0;
        if LenNP = 0 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Inc(SourceIdx, LenOP);
          end
        else if LenNP = 1 then
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            LPResult[DestIdx] := LPNewPattern[0];
            Inc(DestIdx);
            Inc(SourceIdx, LenOP);
          end
        else
          for I := 0 to FindCount - 1 do
          begin
            LCharsToCopy := PosArray[I] - SourceIdx;
            if LCharsToCopy > 0 then
            begin
              if LCharsToCopy = 1 then
              begin
                LPResult[DestIdx] := LPSource[SourceIdx];
                Inc(SourceIdx);
                Inc(DestIdx);
              end
              else if LCharsToCopy <= 8 then
              begin
                for J := 0 to LCharsToCopy - 1  do
                  LPResult[DestIdx + J] := LPSource[SourceIdx + J];
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end
              else
              begin
                Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
                Inc(SourceIdx, LCharsToCopy);
                Inc(DestIdx, LCharsToCopy);
              end;
            end;
            Move(LPNewPattern^, LPResult[DestIdx], LenNP * SizeOf(Char));
            Inc(DestIdx, LenNP);
            Inc(SourceIdx, LenOP);
          end;

        LCharsToCopy := LenS - SourceIdx;
        if LCharsToCopy > 0 then
          Move(LPSource[SourceIdx], LPResult[DestIdx], LCharsToCopy * SizeOf(Char));
      end;
    end
    else
      Result := Source;
  end;
end;



развернул спойлер, и стало страшно
...
Рейтинг: 0 / 0
13.04.2019, 21:17
| Ответить | Цитировать | Написать  
5 сообщений из 5, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Производительность StringReplace
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&fpage=76&tid=2039582]:
 0ms
get settings:
 12ms
get forum list:
 21ms
check forum access:
 5ms
check topic access:
 5ms
track hit:
 342ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 37ms
get tp. blocked users:
 1ms
others: 245ms
total:  681ms
созд. / загр.: 681ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]