Multiple string replace - avoid calling StringReplace multiple times

Mike Torrettinni · March 20, 2021

I finally have a working version that is faster than calling StringReplace numerous times, but I hope there is a way to make it even faster.

So, the purpose of this ReplaceMultiStrings is avoid calling StringRepace multiple times, when we need to replace multiple sub strings, like:

s := StringReplace(s, '&lt;', '<');
s := StringReplace(s, '&gt;', '>');
s := StringReplace(s, '&amp', '&');

Here is description of how my function works:

1. Get all Positions of all substrings

2. Sort Positions, so we make replacements from 1..n one by one (if we don't sort and make replacements randomly within a string, it's a mess...)

3. Loop Positions and make replacements (copy each replacement and parts between replacements into single Result string)

I like the performance, but I was hoping that a single point of constructing final string will give much better performance. But of course the finding all Positions and sorting takes time.

Here are the example timings:

image.png.fe38612c3d9e58d69e599b82e9b15f56.png

With short strings, the performance is close to 50% faster, but with longer strings the difference is much smaller.

Of course there are some limitations if substrings are not unique or substrings are within other substrings. No Case options...and perhaps others.

Source code:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
System.Diagnostics;

type
// Positions
TSubStrPos    = record
    Pos   : integer;
    StrIdx: integer;
end;

// Test cases
TTestCase = record
    Str: string;
    OldPatterns,
    NewPatterns: TArray<string>;
end;
TTestCases = TArray<TTestCase>;

// Custom comparer initialized 1x only
TCustomComparer = class(TInterfacedObject, IComparer<TSubStrPos>)
public
function Compare(const Left, Right: TSubStrPos): Integer;
end;

const
cMaxLoop = 1000000;
cShortA : string = 'abc < 1 > 2';
cMediumA : string = 'medium < text medium > text medium <> text medium text >';
cLongA : string = '<Lorem ipsum sit >amet, <consectetur adipiscing. Integer sagittis dolor a aliquam. >< Vestibulum et purus in dolor consectetur tempor a eget est. Curabitur sit amet erat imperdiet, <scelerisque >suscipit nisl. <Vestibulum velit.';

cShortB : string = 'testing and testing';
cMediumB : string = 'testing and testing and another testing and yet another testing of the test';
cLongB : string = 'Lorem te ipsum ingdolor sit stamet, consectetur adipiingiscing elitesting. Morbi bibendum, mauris Vestibulum vulputate, mauris neque pretium terisus, maximus odio ipsum vel est. Integer sollicitudin massa sit amet semper condimentum. rutrumingte';

cHTML: string =
    '<html><body>This is sample text for StringReplace test.'
    + 'Lorem <ipsum dolor sit amet,& consectetur adipiscing elit. Integer feugiat ullamcorper &ligula, at &vehicula turpis volutpat et. Praesent in sapien vel tortor pulvinar ullamcorper vel et felis. >Praesent mattis efficitur ligula, sit amet'
    + 'venenatis felis. Mauris dui mauris, tempus in turpis at, eleifend tincidunt arcu. Morbi nec tincidunt felis, non viverra nisi. Nulla facilisi.< Donec iaculis, elit >non hendrerit vehicula, urna dui efficitur &quolectus, in tempus metus est'
    + 'sed sem. <Vivamus eleifend euismod orci a volutpat. Ut sed ligula sed sem bibendum facilisis. Morbi gravida neque <nec odio lacinia, at tincidunt &nulla dignissim. Vestibulum vitae >nisi accumsan, dapibus lorem non, &quoconvallis turpis.'
    + 'Pellentesque imp&erdiet malesuada ipsum vel commodo. Nam dignissim< luctus augue, nec maximus felis vehicula eget. Phasellus ultrices lacus <ac elit dapibus &quopellentesque. Morbi vitae eros in turpis> hendrerit volutpat. Cras euismod'
    + ' dolor in scelerisque. Donec &id tincidunt nisi. Praesent ut nunc luctus, pulvinar <mauris ut, hend>rerit nulla. Praesent quis varius lorem.&'
    + '</body></html>';

cSpecialChars : string = 'Testing special char replacemenets: [Lorem te (ipsum) ing(((d)))olo/r -s+it st\\amet, co_!?nse?ctetur adipi-i!ng?isc/ing +(el_)i[_!?]testing.]';

var xComparer: IComparer<TSubStrPos>;

function TCustomComparer.Compare(const Left, Right: TSubStrPos): Integer;
begin
Result := Left.Pos - Right.Pos;
end;

procedure GetSubStrPositions7(const aStr: string; const aOldPatterns, aNewPatterns: array of string; var aPositions: TArray<TSubStrPos>; var aFinalLength: integer);
var vPos, i, vDiff, vIdx: integer;
begin
aFinalLength := aStr.Length;
SetLength(aPositions, 32);
vIdx := 0;
for i := Low(aOldPatterns) to High(aOldPatterns) do
begin
    vPos := Pos(aOldPatterns, aStr);
    vDiff := aNewPatterns.Length - aOldPatterns.Length; // calculate diff of replacements, to adjust aFinalLength
    while vPos <> 0 do
    begin
      if vIdx > High(aPositions) then
        SetLength(aPositions, Length(aPositions) * 2);

      aPositions[vIdx].Pos := vPos;
      aPositions[vIdx].StrIdx := i;
      Inc(vIdx);
      aFinalLength := aFinalLength + vDiff;
      vPos := Pos(aOldPatterns, aStr, vPos + 1);
    end;
end;
SetLength(aPositions, vIdx);
end;

function ReplaceMultiStringsByPositions7(const aStr: string; const aPositions: TArray<TSubStrPos>; const aOldPatterns, aNewPatterns: array of string; aResultLen: integer): string;
var i, vResPos, vStrPos: Integer;
begin
SetLength(Result, aResultLen);

// move substrings by index + between indexes, if any
vResPos := 1; vStrPos := 1;
for i := Low(aPositions) to High(aPositions) do
begin
    // Copy free text between last Pos and current Pos
    if aPositions.Pos > vStrPos then
    begin
      Move(aStr[vStrPos], Result[vResPos], (aPositions.Pos - vStrPos)*SizeOf(Char));
      Inc(vResPos, aPositions.Pos - vStrPos);
    end;

    // copy New str
    Move(aNewPatterns[aPositions.StrIdx][1], Result[vResPos], aNewPatterns[aPositions.StrIdx].Length * SizeOf(Char));
    // move Pos by New str len
    Inc(vResPos, aNewPatterns[aPositions.StrIdx].Length);
    // move aStr Pos
    vStrPos := aPositions.Pos + aOldPatterns[aPositions.StrIdx].Length;
end;

// copy any left after last replacement
if vStrPos < aStr.Length then
Move(aStr[vStrPos], Result[vResPos], (aStr.Length - vStrPos + 1) * SizeOf(Char));
end;

procedure SortPositions(var aPositions: TArray<TSubStrPos>);
begin
if xComparer = nil then
xComparer := TCustomComparer.Create; // initialize Comparer

TArray.Sort<TSubStrPos>(aPositions, xComparer);
end;

function ReplaceMultiStrings7(const aStr: string; const aOldPatterns, aNewPatterns: array of string): string;
var vPositions: TArray<TSubStrPos>;
vResultLen: integer;
begin
// Get Positions for all string replacements
GetSubStrPositions7(aStr, aOldPatterns, aNewPatterns, vPositions, vResultLen);

// Sort Positions so the replacements go from first to last pos
SortPositions(vPositions);

// Replace by indexes
Result := ReplaceMultiStringsByPositions7(aStr, vPositions, aOldPatterns, aNewPatterns, vResultLen);
end;

{ Standard StringReplace used multiple times }
function StringReplaceAll(const aStr: string; const aOldPatterns, aNewPatterns: array of string): string;
var i: Integer;
begin
Result := aStr;
for i := Low(aOldPatterns) to High(aOldPatterns) do
Result := StringReplace(Result, aOldPatterns, aNewPatterns, [rfReplaceAll]);
end;

{ Test cases }
procedure AddTestCase(var aTestCases: TTestCases; const aStr: string; const aOldPatterns, aNewPatterns: TArray<string>);
var vTestCase: TTestCase;
begin
vTestCase.Str := aStr;
vTestCase.OldPatterns := aOldPatterns;
vTestCase.NewPatterns := aNewPatterns;

aTestCases := aTestCases + [vTestCase];
end;

procedure RunTestCases(const aTestCases: TTestCases);
var i: Integer;
    s, s1: string;
begin
for i := Low(aTestCases) to High(aTestCases) do
begin
    s := StringReplaceAll(aTestCases.Str, aTestCases.OldPatterns, aTestCases.NewPatterns);
    s1 := ReplaceMultiStrings7(aTestCases.Str, aTestCases.OldPatterns, aTestCases.NewPatterns);
    if (s <> s1) then
      raise Exception.Create('Not equal results: ' + sLineBreak + s + sLineBreak + s1);
end;
end;

procedure DoTheTiming(const aCaption, aStr: string; const aOldPatterns, aNewPatterns: array of string);
var vSW:TStopWatch;
i: integer;
str: string;
begin
Writeln(aCaption);

vSW := TStopWatch.StartNew;
for i := 1 to cMaxLoop do
begin
    str := '';
    str := StringReplaceAll(aStr, aOldPatterns, aNewPatterns);
end;
Writeln('StringReplaceAll:     ' + vSW.ElapsedMilliseconds.ToString);

vSW := TStopWatch.StartNew;
for i := 1 to cMaxLoop do
begin
str := '';
str := ReplaceMultiStrings7(aStr, aOldPatterns, aNewPatterns);
end;
Writeln('ReplaceMultiStrings7: ' + vSW.ElapsedMilliseconds.ToString);
Writeln;
end;

var vTestCases: TTestCases;

begin
// make sure string replacement is correct!
AddTestCase(vTestCases, cShortA, ['<', '>'], ['<', '>']);
AddTestCase(vTestCases, cMediumA, ['<', '>'], ['<', '>']);
AddTestCase(vTestCases, cLongA, ['<', '>'], ['<', '>']);
AddTestCase(vTestCases, cShortB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);
AddTestCase(vTestCases, cShortB, ['te'], ['AND']);
AddTestCase(vTestCases, cShortB, ['and'], ['ab']);
AddTestCase(vTestCases, cMediumB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);
AddTestCase(vTestCases, cMediumB, ['te'], ['AND']);
AddTestCase(vTestCases, cMediumB, ['and'], ['ab']);
AddTestCase(vTestCases, cLongB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);
AddTestCase(vTestCases, cLongB, ['te'], ['AND']);
AddTestCase(vTestCases, cLongB, ['and'], ['ab']);
AddTestCase(vTestCases, cHTML, ['<', '>', '&amp', '"'], ['<', '>', '&', '"']);
AddTestCase(vTestCases, cSpecialChars, ['\', '/', '!', '?', '[', ']', '_', '(', ')', '-', '+'], ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k']);

RunTestCases(vTestCases);

// DoTheTiming('Short str A:', cShortA, ['<', '>'], ['<', '>']);
// DoTheTiming('Medium str A:', cMediumA, ['<', '>'], ['<', '>']);
// DoTheTiming('Long str A:', cLongA, ['<', '>'], ['<', '>']);

DoTheTiming('Short str B:', cShortB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);
DoTheTiming('Medium str B:', cMediumB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);
DoTheTiming('Long str B:', cLongB, ['te', 'st', 'ing', 'and'], ['ab', 'cd', 'ef', 'AND']);

DoTheTiming('HTML:', cHTML, ['<', '>', '&amp', '"'], ['<', '>', '&', '"']);
DoTheTiming('Special Chars:', cSpecialChars, ['\', '/', '!', '?', '[', ']', '_', '(', ')', '-', '+'], ['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k']);

Writeln('done...');
Readln;

end.

Any advice is appreciated!

Edited March 20, 2021 by Mike Torrettinni

Dalija Prasnikar · March 20, 2021

6 hours ago, Mike Torrettinni said:

Here is description of how my function works:

1. Get all Positions of all substrings

2. Sort Positions, so we make replacements from 1..n one by one (if we don't sort and make replacements randomly within a string, it's a mess...)

3. Loop Positions and make replacements (copy each replacement and parts between replacements into single Result string)

Initial idea that multiple scans are bad for performance is good, but your steps are wrong.

You should scan the string for all substrings in one go, but you should also build new string while you are scanning. Using TStringBuilder or similar pattern with preallocated buffer would be appropriate.

And when I sad scanning string for substrings, don't use Pos function. Scan string one character at the time and match it with patterns you are looking.

Edited March 20, 2021 by Dalija Prasnikar

Stefan Glienke · March 20, 2021

A few notes:

- the position array will very likely be rather short - unless you going to replace words in a novel or something like that. Handwritten InsertionSort will outperform that.

- avoid dynamic allocation for the position array - use a static array with a reasonable standard size and only fall back to dynamically allocating if that is not enough

- after fixing that I get an improvement of around 1/3 over the code you posted and now SamplingProfiler tells me that the code stays in System.Pos for like 50% of the time - that cannot be right

Also you have a bug:

AddTestCase(vTestCases, 'ReplaceReplaceString', ['Replace', 'FooString'], ['Foo', 'Bar']);

Edited March 20, 2021 by Stefan Glienke

Mike Torrettinni · March 20, 2021

1 hour ago, Dalija Prasnikar said:

And when I sad scanning string for substrings, don't use Pos function. Scan string one character at the time and match it with patterns you are looking.

I tried that, for each char in string loop all substrings if any match. It was slower, perhaps because it was Pos is using asm.

Will have another look at this example and will provide a code.

2 hours ago, Stefan Glienke said:

- avoid dynamic allocation for the position array - use a static array with a reasonable standard size and only fall back to dynamically allocating if that is not enough

Initially I had static array [0..1000] and stored all positions of substrings. But looping and finding if that position is > 0 proved to be bottleneck, even when I had MaxIndex (length of string) < 1000 and was looping from 0 to MaxIndex.

I tried many options and I could have made a mistake with previous versions, but this one proved to be the only one faster, the rest were really fast on short and much slower on longer strings.

Will try InsertionSort.

Mike Torrettinni · March 20, 2021

2 hours ago, Stefan Glienke said:

Also you have a bug:

AddTestCase(vTestCases, 'ReplaceReplaceString', ['Replace', 'FooString'], ['Foo', 'Bar']);

Not a bug, but a fact that StringReplace replaces substrings sequentially not all in one step, like my function. Multiple calls in StringReplace go like this:

1. s := StringReplace('ReplaceReplaceString', 'Replace', 'Foo'); -> s = 'FooFooString'

2. s := StringReplace(s, 'FooString', 'Bar'); -> s = 'FooBar'

my function:

s := ReplaceMultiStrings7('ReplaceReplaceString', ['Replace', 'FooString'], ['Foo', 'Bar']) ->no 'Foo' found in original string, so no replacement, except 'Replace' is replaced with 'Foo' -> s = 'FooFooString'

This test raises error because they are different results, but they are both correct results, just this is rare cases where both functions works correct and produce different results.

I mean, you can't expect to replace 'Foo' if there is no 'Foo' in original string.

Am I wrong in this thinking, does the explanation make sense or am I just trying to justify that my function works correctly?

Stefan Glienke · March 20, 2021

Whether you decide is up to your own spec, but according to your testcase its a defect 🤷‍♂️

Dave Novo · March 20, 2021

Did you ever have a look at the old faststrings library? It was for ansi strings only, but they had a lot of good ideas. Plus, if you happen to be using ansi strings only for your application (or at least part of it) it is very fast.

Mike Torrettinni · March 21, 2021

25 minutes ago, Dave Novo said:

Did you ever have a look at the old faststrings library? It was for ansi strings only, but they had a lot of good ideas. Plus, if you happen to be using ansi strings only for your application (or at least part of it) it is very fast.

I think Delphi's standard StringReplace is based on implementation from FastStrings, already, but there's a lot of tricks that don't apply to unicode anymore. But if you have specific idea I should look at, please let me know.

Mike Torrettinni · March 21, 2021

@Dalija Prasnikar I have 2 additional versions:

MultiStrReplace3 - which loops string char by char and compares each substring. The problem here is that I don't precalculate final lenght of Result, so it's a guess. From results we can see is fastest for really short strings, but way slower with medium or long examples.

MultiStringReplaceSB - example using TStringBuilder and is slowest in all examples.

image.png.0d39c8689e33837f11f2be35efdfc8fd.png

Of course there is quite high possibility I have made a mistake and one of the new versions could be best.

@Stefan Glienke I implemented InsertionSort and you are correct, it is faster. If you have more details on how you implemented static array that would make it even faster, I would like to know since my implementation of static array didn't prove successful.

Updated source: