Recent

Author Topic: CompareText improvement  (Read 4450 times)

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
CompareText improvement
« on: March 23, 2023, 05:13:12 am »
Hi, I'm always trying to improve the language I love, so I want to share a faster function for comparing strings, would you add it to sysstrh.inc? 

Code: Pascal  [Select][+][-]
  1. type
  2.   TFoT = (Falso, Verdadero);
  3.  
  4. class function CompareText(const S1, S2: string): integer; inline;  // sysstrh.inc
  5. var
  6.   i, count, count1, count2: integer; Chr1, Chr2: byte;
  7.   P1, P2: PChar;
  8. begin
  9.   Count1 := Length(S1);         // 5
  10.   Count2 := Length(S2);         // 5
  11.   if (Count1>Count2) then       // 3
  12.     Count := Count2             // 3
  13.   else
  14.     Count := Count1;            // 2
  15.   i := 0;                       // 1 mov %eax, -0x18(%rbp)
  16.   if count>0 then               // 2 ____ tot 21
  17.     begin
  18.       P1 := @S1[1];             // 2
  19.       P2 := @S2[1];             // 2
  20.       while i < Count do        // 2
  21.         begin
  22.           Chr1 := byte(p1^);    // 3
  23.           Chr2 := byte(p2^);    // 3
  24.           if Chr1 <> Chr2 then  // 3
  25.             begin
  26.               if Chr1 in [97..122] then  // 4
  27.                 dec(Chr1,32);            // 1 subb
  28.               if Chr2 in [97..122] then  // 4
  29.                 dec(Chr2,32);            // 1
  30.               if Chr1 <> Chr2 then       // 3 Break inplicit jmp?
  31.                 Break;
  32.             end;
  33.           Inc(P1); Inc(P2); Inc(I);      // 3
  34.         end;
  35.     end;
  36.   if i < Count then   // simply rest?    // 3
  37.     result := Chr1-Chr2                  // 5
  38.   else
  39.     result := count1-count2;             // 4   tot 64 asm instructions
  40. end;
  41.  
  42. Class function TextComp(const S1, S2: string): boolean; inline;
  43. var L1, L2: integer;
  44.   i: integer = 0;
  45.   P1, P2: PChar;
  46.   Chr1, Chr2: byte;
  47. begin
  48.   L1 := length(S1);                  // 5
  49.   L2 := length(S2);                  // 5
  50.   Result := L1 = L2;                 // 3
  51.   if (L1 > 0) and Result then begin  // 4 Tot 17
  52.     P1 := @S1[1];                    // 2
  53.     P2 := @S2[1];                    // 2
  54.     repeat
  55.       Chr1 := ord(P1^);              // 3
  56.       Chr2 := ord(P2^);              // 3
  57.       if Chr1 <> Chr2 then begin     // 3
  58.         if Chr1 in [$41..$5A] then   // 4
  59.           Chr1 := Chr1 or $20;       // 1 orb
  60.         if Chr2 in [$41..$5A] then   // 4
  61.           Chr2 := Chr2 or $20;       // 1
  62.         if Chr1 <> Chr2 then begin   // 3
  63.           Result := False;           // 1
  64.           Exit;                      // 1
  65.         end;
  66.       end;
  67.       inc(i); inc(P1); inc(P2);   // 3
  68.     until i >= L1;                // 3    tot 51
  69.   end;
  70. end;
  71.  
  72. const Maxi = 10000000;
  73. var
  74.   S1: string = 'FrEe PaScAl and DELPHI are easier THAN C++';
  75.   S2: String = 'fReE pAsCaL AND delphi ARE EASIER than c++';
  76.   i, j: integer;
  77.   B: boolean;
  78.   t: longint;
  79.   S: String;
  80. initialization
  81.   writeln(Format('Comparing S1=''%s'' and S2=''%s''', [S1, S2]));
  82.  
  83.   t := GetTickCount64();
  84.   for i := -Maxi to Maxi do
  85.     j := CompareText(S1, S2);
  86.   t := GetTickCount64() - t;
  87.   writeln(Format('CompareText: %d, %d ms', [j, t]));
  88.  
  89.   t := GetTickCount64();
  90.   for i := -Maxi to Maxi do
  91.     B := TextComp(S1, S2);
  92.   t := GetTickCount64() - t;
  93.   WriteStr(S, TFoT(B));
  94.   writeln(Format('TextComp: %s, %d ms', [S, t]));
  95.  
  96.   halt(0);
  97. end.

--- Benchmarks ---
Code: Text  [Select][+][-]
  1. Comparing S1='FrEe PaScAl and DELPHI are easier THAN C++' and S2='fReE pAsCaL AND delphi ARE EASIER than c++'
  2. CompareText: 0, 10117 ms
  3. TextComp: Verdadero, 8839 ms

more than 10% faster!

if you add this function, please, mention my email somewhere: edgarrod71@gmail.com
« Last Edit: March 23, 2023, 08:09:37 pm by edgarrod71 »

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 11383
  • FPC developer.
Re: CompareText improvement
« Reply #1 on: March 23, 2023, 09:37:38 am »
The standard comparetext on the Windows target supports casing of accents and other special letters.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 9792
  • Debugger - SynEdit - and more
    • wiki
Re: CompareText improvement
« Reply #2 on: March 23, 2023, 09:58:04 am »
Somewhere in LazUtils there are some similar functions "Compare....Fast"

The idea was to compare like you do, until you hit a unicode char > 127.
So when comparing terms from the English language you would benefit.

The problem is even that approach causes failures. (and I am not sure if they are currently fixed).

One issue is, that those comparisons could not be used for sorting (even if sort order did not matter). Because they were not transitive.
They may have reported that
- String2 goes AFTER String1
- String3 goes AFTER String2
- String3 goes BEFORE String1
And sorting can not fulfil the last statement.

Some of that was fix-able (but not sure if currently fixed).
Other issues (don't recall their nature) might not be fixable.

So those functions can be used for equality check, but not sorting/ordering.

Stefan Glienke

  • New Member
  • *
  • Posts: 23
Re: CompareText improvement
« Reply #3 on: March 23, 2023, 05:07:58 pm »
If that CompareText is a copy from the RTL then there is more to be gained than just 10%  8-)

Comparing byte by byte will not get you anywhere performance-wise.

For reference: https://fastcode.sourceforge.net/challenge_content/CompareText.html
« Last Edit: March 23, 2023, 05:13:01 pm by Stefan Glienke »

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
Re: CompareText improvement
« Reply #4 on: March 23, 2023, 07:49:41 pm »
@Stefan Glienke 10% in everything is really an improvement.  When you get any discount 10% on expensive things you start to smile... ;)   

By the way, where is your attachment in toll lazarus version?

@Martin_fr  I know that, it's simply a replacement for CompareText or an option to it.
« Last Edit: March 23, 2023, 08:07:26 pm by edgarrod71 »

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: CompareText improvement
« Reply #5 on: March 23, 2023, 09:39:06 pm »
@Martin_fr  I know that, it's simply a replacement for CompareText or an option to it.

It is not a replacement, because CompareText can be used for sorting, yours can not. And it won't be added as an alternative, because there already is the existing CompareText.

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
Re: CompareText improvement
« Reply #6 on: March 24, 2023, 06:57:28 pm »
I'm not saying you're wrong... but!  Inside fpcsrc there are 246 calls to CompareText and in Lazarus source code there are 180+ (depending on the components you install) and not all of them are meant for sorting!

When both strings are the same, benchmarks give us 10% aprox. but when they are different benchmark give us more than 90% of acceleration depending on what we want to achieve.  For instance, I discovered there was a problem with RegisterFileLocation on weblaz and when I saw another error on it, I found that CompareText is not the best solution.

So, I think we must put ego out and take a humbling sight, our community will be benefit on faster apps.


wp

  • Hero Member
  • *****
  • Posts: 11855
Re: CompareText improvement
« Reply #7 on: March 24, 2023, 07:10:46 pm »
10% only if every program would consist only of CompareText calls! Your improvement will not be detectable in practice. Conversely, such micro-optimization usually introduces new bugs.

domasz

  • Sr. Member
  • ****
  • Posts: 423
Re: CompareText improvement
« Reply #8 on: March 24, 2023, 08:18:04 pm »
How about working in 32/64 bits? Perhaps I am not seeing some details but something like below should be faster:

Code: Pascal  [Select][+][-]
  1. function AnsiCompare(S1,S2: String);
  2. var A1: array of Int64;
  3.       B1: array of Int64;
  4. begin
  5.   SetLength...
  6.   FillChar...
  7.   Move(S1[1], A1[0], Length(S1));
  8.   Move(S2[1], A2[0], Length(S2));
  9.  
  10.   for i:=0 to Length-1 do if A1[i] < A2[i] then ...
  11. end;

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
Re: CompareText improvement
« Reply #9 on: March 24, 2023, 09:03:13 pm »
@domasz, looking above the lake, water seems to be delicious, nevertheless, going deep, I found that this calls all of these:

Code: Pascal  [Select][+][-]
  1. const
  2.   MB_CUR_MAX = 10;
  3.  
  4. type
  5.   TFoT = (Falso, Verdadero);
  6.   wint_t = longint;
  7.   clonglong = wint_t;
  8.   mbstate_t = record
  9.     case byte of
  10.       0: (__mbstate8: array[0..127] of char);
  11.       1: (_mbstateL: clonglong); { for alignment }
  12.   end;
  13.   size_t = qword;
  14.   wchar_t = longint;
  15.   pmbstate_t = ^mbstate_t;
  16.  
  17. function wcrtomb(s: pchar; wc: wchar_t; ps: pmbstate_t): size_t; cdecl; external clib name 'wcrtomb';
  18.  
  19. procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;
  20. begin
  21.   if (len>length(s)) then
  22.     if (length(s) < 10*256) then
  23.       setlength(s,length(s)+10)
  24.     else
  25.       setlength(s,length(s)+length(s) shr 8);
  26. end;
  27.  
  28. procedure ConcatCharToAnsiStr(const c: char; var S: AnsiString; var index: SizeInt);
  29. begin
  30.   EnsureAnsiLen(s,index);
  31.   pchar(@s[index])^:=c;
  32.   inc(index);
  33. end;
  34.  
  35. { concatenates an utf-32 char to a widestring. S *must* be unique when entering. }
  36. {$if not(defined(beos) and not defined(haiku))}
  37. procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt; var mbstate: mbstate_t);
  38. {$else not beos}
  39. procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt);
  40. {$endif beos}
  41. var
  42.   p     : pchar;
  43.   mblen : size_t;
  44. begin
  45.   { we know that s is unique -> avoid uniquestring calls}
  46.   p:=@s[index];
  47.   if (nc<=127) then
  48.     ConcatCharToAnsiStr(char(nc),s,index)
  49.   else
  50.     begin
  51.       EnsureAnsiLen(s,index+MB_CUR_MAX);
  52. {$if not(defined(beos) and not defined(haiku))}
  53.       mblen:=wcrtomb(p,wchar_t(nc),@mbstate);
  54. {$else not beos}
  55.       mblen:=wctomb(p,wchar_t(nc));
  56. {$endif not beos}
  57.       if (mblen<>size_t(-1)) then
  58.         inc(index,mblen)
  59.       else
  60.         begin
  61.           { invalid wide char }
  62.           p^:='?';
  63.           inc(index);
  64.         end;
  65.     end;
  66. end;
  67.  
  68. function UpperAnsiString(const s : AnsiString) : AnsiString;
  69.   var
  70.     i, slen,
  71.     resindex : SizeInt;
  72.     mblen    : size_t;
  73. {$if not(defined(beos) and not defined(haiku))}
  74.     ombstate,
  75.     nmbstate : mbstate_t;
  76. {$endif beos}
  77.     wc       : wchar_t;
  78.   begin
  79. {$if not(defined(beos) and not defined(haiku))}
  80.     fillchar(ombstate,sizeof(ombstate),0);
  81.     fillchar(nmbstate,sizeof(nmbstate),0);
  82. {$endif beos}
  83.     slen:=length(s);
  84.     SetLength(result,slen+10);
  85.     i:=1;
  86.     resindex:=1;
  87.     while (i<=slen) do
  88.       begin
  89.         if (s[i]<=#127) then
  90.           begin
  91.             wc:=wchar_t(s[i]);
  92.             mblen:= 1;
  93.           end
  94.         else
  95. {$if not(defined(beos) and not defined(haiku))}
  96.           mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
  97. {$else not beos}
  98.           mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
  99. {$endif beos}
  100.         case mblen of
  101.           size_t(-2):
  102.             begin
  103.               { partial invalid character, copy literally }
  104.               while (i<=slen) do
  105.                 begin
  106.                   ConcatCharToAnsiStr(s[i],result,resindex);
  107.                   inc(i);
  108.                 end;
  109.             end;
  110.           size_t(-1), 0:
  111.             begin
  112.               { invalid or null character }
  113.               ConcatCharToAnsiStr(s[i],result,resindex);
  114.               inc(i);
  115.             end;
  116.           else
  117.             begin
  118.               { a valid sequence }
  119.               { even if mblen = 1, the uppercase version may have a }
  120.               { different length                                     }
  121.               { We can't do anything special if wchar_t is 16 bit... }
  122. {$if not(defined(beos) and not defined(haiku))}
  123.               ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);
  124. {$else not beos}
  125.               ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);
  126. {$endif not beos}
  127.               inc(i,mblen);
  128.             end;
  129.           end;
  130.       end;
  131.     SetLength(result,resindex-1);
  132.   end;
  133.  
  134. function StrCompAnsiIntern(s1,s2 : PChar; len1, len2: PtrInt; canmodifys1, canmodifys2: boolean): PtrInt;
  135.   var
  136.     a,b: pchar;
  137.     i: PtrInt;
  138.   begin
  139.     if not(canmodifys1) then
  140.       getmem(a,len1+1)
  141.     else
  142.       a:=s1;
  143.     for i:=0 to len1-1 do
  144.       if s1[i]<>#0 then
  145.         a[i]:=s1[i]
  146.       else
  147.         a[i]:=#32;
  148.     a[len1]:=#0;
  149.  
  150.     if not(canmodifys2) then
  151.       getmem(b,len2+1)
  152.     else
  153.       b:=s2;
  154.     for i:=0 to len2-1 do
  155.       if s2[i]<>#0 then
  156.         b[i]:=s2[i]
  157.       else
  158.         b[i]:=#32;
  159.     b[len2]:=#0;
  160.     result:=strcoll(a,b);
  161.     if not(canmodifys1) then
  162.       freemem(a);
  163.     if not(canmodifys2) then
  164.       freemem(b);
  165.   end;
  166.  
  167.  
  168. function AnsiCompareText(const S1, S2: ansistring): PtrInt;
  169.   var
  170.     a, b: AnsiString;
  171.   begin
  172.     a:=UpperAnsistring(s1);
  173.     b:=UpperAnsistring(s2);
  174.     result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b),true,true);
  175.   end;
  176.  

So I think it is not faster... :(

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
Re: CompareText improvement
« Reply #10 on: March 24, 2023, 09:11:20 pm »
Benchmarks with same text and different...

Code: Bash  [Select][+][-]
  1. fer-mb-pro:programming stuff fernandodager$ ./string_comparison
  2. Comparing S1='definitely, FrEe PaScAl and DELPHI are easier THAN C++ and Bill Sucks' and S2='DEFiNITELY, fReE pAsCaL AND delphi ARE EASIER than c++ AND bILL sUCKS'
  3. CompareText: 0, 18504 ms
  4. TextComp: Verdadero, 16585 ms
  5. AnsiCompareText: 0, 60569 ms
  6. fer-mb-pro:programming stuff fernandodager$ ./string_comparison
  7. Comparing S1='definitely, FrEe PaScAl and DELPHI are easier THAN C++ and Bill Sucks' and S2='REFiNITELY, fReE pAsCaL AND delphi ARE EASIER than c++ AND bILL sUCKS'
  8. CompareText: -14, 622 ms
  9. TextComp: Falso, 575 ms
  10. AnsiCompareText: -14, 59806 ms
  11. fer-mb-pro:programming stuff fernandodager$

edgarrod71

  • Jr. Member
  • **
  • Posts: 68
Re: CompareText improvement
« Reply #11 on: March 24, 2023, 09:18:10 pm »
For instance, I'm really sure if we change all of these function calls with the proposed one, we'll have a better debugger, synedit, and propedits, and everything even!


PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: CompareText improvement
« Reply #12 on: March 24, 2023, 10:11:51 pm »
So, I think we must put ego out and take a humbling sight, our community will be benefit on faster apps.

This has nothing to do with ego, but with maintainability which is the most important factor in a project like this, even more important than performance! There will only be one CompareText function and that must allow for sort comparison or it's absolutely useless as a replacement. Any performance improvement must be secondary to that requirement.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 9792
  • Debugger - SynEdit - and more
    • wiki
Re: CompareText improvement
« Reply #13 on: March 24, 2023, 10:13:27 pm »
For instance, I'm really sure if we change all of these function calls with the proposed one, we'll have a better debugger, synedit, and propedits, and everything even!

How so?

Ignoring the fact that some of those may need to compare non-latin text, which ones are to sooooo slow for you?
Some of them might already use the "compare...fast" methods I did mention (where and when actually possible).


For example the debugger (FpDebug) is using it's own methods were possible. But where it needs utf8 it needs to have the full deal. And also it minimizes comparisons by using pre-computed hashes, therefore even if you double the speed of text comparison, it would likely make less than one percent of an improvement.
Actually I happen to have a recent (Laz 2.3 based) valgrind/callgrind analysis. It spends about
  1% in various fpc comparetext
  1% in uppercase
  0.1% in its own compare text
  0.05% in lowercase
So about 2%. if you could write replacements with full unicode (non-latin incl.) support, and make it twice as fast, then the total speedup of the debugger would be 1%. Only your replacement don't double the speed and don't have full unicode support


Mind however, that the speed of those things that you listed depends heavily on "release builds". If you compile the IDE with heaptrc (-gh) then that has an impact. (not due to compare, but affecting the listed items in other ways).

In that context: If you use fpc 3.2.2 => do NOT use -O2 or higher. It is broken. The IDE will crash (most likely when you debug your project).
But even a release build with -O1 does quite well.

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 9792
  • Debugger - SynEdit - and more
    • wiki
Re: CompareText improvement
« Reply #14 on: March 24, 2023, 10:20:31 pm »
Btw, about benchmarking.

If you test functions, there is a chance that the result will be influenced by other code (even unrelated code) around your comparison code. The caching and processing the CPU uses can be influenced by this, and speed of the exact same code can vary by up to 30%.

So changes up to 30% time difference may not be caused by your code. They may be caused by other side effect.
Those side effect may then not happen in a real application.
Or in the real app the side effect may speed up the current fpc code, but not yours.....

That said, some of your measurements are in an expected range, and therefore likely not affected by this.

 

TinyPortal © 2005-2018