Any build-in Delphi function like PosEx that finds a sub-string starting from the back of the string?

Question

Is there any Delphi D2010 function like PosEx that finds a sub-string inside a string starting from the end of the string?

I'm removing all the calls to the FastStrings library and one of the functions I was using was FastPosBack:

function FastPosBack(const aSourceString, aFindString : AnsiString; const aSourceLen, aFindLen, StartPos : Integer) : Integer;

I found LastDelimiter but it's not quite the same thing since it only finds the last delimiter and I can't specify a start position.

Thanks!

Update: Following DR comment, I've created this function:

function FastPosBack(const aSourceString, aFindString : String; const aSourceLen, aFindLen, StartPos : Integer) : Integer;
var
  RevSourceString, RevFindString: string;
begin
  RevSourceString := AnsiReverseString(aSourceString);
  RevFindString := AnsiReverseString(aFindString);

  Result := Length(aSourceString) - PosEx(RevFindString, RevSourceString, StartPos) + 1;
end;

Is there any more effective way of doing this? On a 1000000 loop cycle, Pos takes 47ms while FastPosBack takes 234ms to complete.

Answer 1

Try this/these:

function RPos(const aSubStr, aString : String; const aStartPos: Integer): Integer; overload;
var
  i: Integer;
  pStr: PChar;
  pSub: PChar;
begin
  pSub := Pointer(aSubStr);

  for i := aStartPos downto 1 do
  begin
    pStr := @(aString[i]);
    if (pStr^ = pSub^) then
    begin
      if CompareMem(pSub, pStr, Length(aSubStr)) then
      begin
        result := i;
        EXIT;
      end;
    end;
  end;

  result := 0;
end;


function RPos(const aSubStr, aString : String): Integer; overload;
begin
  result := RPos(aSubStr, aString, Length(aString) - Length(aSubStr) + 1);
end;

The overload provides a way to call RPos using the most efficient startpos for searching from the very end of the string without having to calculate that yourself. For efficiency no checking is performed on startpos when explicitly specified.

In my SmokeTest performance testing suite this comes out about 20% faster than your FastPosBack (which incidentally contains an "off by one" error as well as requiring some parameters which it doesn't actually use).

Answer 2

You can use Pos in combination with ReverseString (from StrUtils)

Answer 3

Delphi comes with a function that can search backward, SearchBuf in the StrUtils unit. It's specialized for searching for words, though, so it might not behave quite the way you want. Below I've wrapped it into a function matching your desired interface.

function FastPosBack(const aSourceString, aFindString: AnsiString;
                     const aSourceLen, aFindLen, StartPos: Integer): Integer;
var
  Source, Match: PAnsiChar;
begin
  Source := PAnsiChar(ASourceString);
  Match := SearchBuf(Source, ASourceLen, ASourceLen, 0,
                     AFindString, [soMatchCase]);
  if Assigned(Match) then
    Result := Match - Source + 1
  else
    Result := 0;
end;

Answer 4

First, consider if a speed optimized solution is necessary. If its not likely that it will be called 100000 times in real use reversing the strings and using the existing substring search is fine.

If speed is an issue, there are plenty of good resources for writing you own. Look on wikipedia for "string search algorithms" for ideas. I'll post a link and an example algorithm when I'm at a computer. I'm typing this from my phone at the moment.

Update:

Here's the example I promised:

function RPOS(pattern: string; text:string): Integer;
var patternPosition,
    textPosition: Integer;
begin
  Result := -1;
  for textPosition := Length(text) downto 0 do
  begin
    for patternPosition := Length(pattern) downto 0 do
      if not (pattern[patternPosition] = (text[textPosition - (Length(pattern) - patternPosition)])) then
        break;
    if patternPosition = 0 then
      Result := textPosition -Length(pattern) + 1;
  end;
end;

Its basically an inverted naive(brute force) string search algorithm. It starts at the end of both the pattern and text and works its way to the beginning. I can guarantee it is less efficient than Delphi's Pos() function though I can't say whether its faster or slower than the Pos()-ReverseString() combination as I haven't tested it. There is an error in it which I haven't found the cause of. If the two strings are identical its returning -1 (not found).

Answer 5

I use the RPOS variants from Free Pascal's strutils function:

http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/rtl/objpas/strutils.pp?view=markup

the string,string version is nearly the same as Deltics', but there are variants:

Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
Function RPos(c:char;const S : AnsiString):Integer; overload;
Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;

They are licensed unde FPC's LGPL+linking exception license, but since I wrote them, I hereby release them under BSD license.

Answer 6

Not in the standard RTL but in INDY (unit idGlobalProtocols according to the online help), which is part of recent Delphi installations:

function RPos(
    const ASub: String, 
    const AIn: String, 
    AStart: Integer = -1
): Integer;

Answer 7

Maybe adding Uppercasing or lowercasing aSubstr and aString parameters before doing the search can make Deltics purpose case insensitive. I think he left you to do this before calling RPos. but maybe an optional parameter can do the job.

this is how Deltic's purpose should look:

function RPos(const aSubStr, aString : String; const aStartPos: Integer;
              const aCaseInSensitive:boolean=true): Integer; overload;
var
  i, _startPos: Integer;
  pStr: PChar;
  pSub: PChar;
  _subStr, _string: string;
begin

 if aCaseInSensitive then
 begin
  _subStr := lowercase( aSubstr );
  _string := lowercase( aString );
 end
 else 
 begin
  _subStr := aSubstr:
  _string := aString;
 end;

 pSub := Pointer(_subStr);

 if aStartPos = -1 then
    _startPos :=  Length(_string) - Length(_subStr) + 1
 else
    _startPos := aStartPos;

 for i := _startPos downto 1 do
 begin
   pStr := @(_string[i]);
   if (pStr^ = pSub^) then
   begin
     if CompareMem(pSub, pStr, Length(_subStr)) then
     begin
       result := i;
       EXIT;
     end;
   end;
 end;

 result := 0;
end;


function RPos(const aSubStr, aString : String; 
              const aCaseInSensitive:boolean=true): Integer; overload;
begin
  result := RPos(aSubStr, aString, Length(aString) - Length(aSubStr) + 1,
                 aCaseInSensitive);
end;