Slow TStringList.Sort in Applications.
lazarus / 64-FPC development

----------------------------------------------------------------------
Borneq · 2022-05-02 13:21

This forum is proper for this post? Post is about error/bad behavior
of FPC.
I have tested sort time in FPC console, FPC applications and GCC
release console. I have Linux Fedora and Laptop with core I3 20 GB
RAM.
variable d means:
big value like 100 = most strings are different each with other
small value like 0.01 = a lot of the same string valiues
First FPC console compiled with aggressive optimalization
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
timeSortCon; uses Linux, unixtype, Classes, SysUtils, Math;  procedure
fill(list: TStringList; size: integer; d: double);var  i,n:
integer;begin  list.Clear;  for i:=0 to size-1 do  begin   
n:=Random(round(size*d));    list.Add(IntToStr(n));  end;end; const
c1e9 = 1000*1000*1000;var  tp1,tp2: ttimespec;  t1,t2: int64; 
list:TStringList;  size: integer;  d: double;begin 
list:=TStringList.Create;  size:=1024;  d:=100;  repeat     Fill(list,
size, d);     clock_gettime(CLOCK_MONOTONIC, @tp1);     list.sort(); 
  clock_gettime(CLOCK_MONOTONIC, @tp2);   
 t1:=tp1.tv_nsec+tp1.tv_sec*c1e9;   
 t2:=tp2.tv_nsec+tp2.tv_sec*c1e9;   
 writeln(FloatToStr((t2-t1)/Math.Log2(size)/size));     size:=size*2; 
until size>4*1024*1024;  list.Free;  writeln('end');end. output is

33.86015625
33.3103249289773
33.4970092773438
35.7384127103365
37.3490033830915
38.675048828125
38.206618309021
42.8031939338235
45.9571946461995
51.8758956507633
53.9631856918335
62.9143598420279
69.6882724003358
end

id d = 0.01:

112.74697265625
104.522283380682
88.3057861328125
66.2308349609375
65.185782296317
66.95908203125
66.3638725280762
70.4515856574563
77.0949376424154
77.421782844945
80.1974610805511
87.4744812647502
91.7128844369542
end

A bit slower
Compare to C++:
Code: C  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i #include
<iostream>#include <algorithm>#include <vector>#include
<chrono>#include <cmath>using namespace std; class stopwatch{public: 
 chrono::time_point<chrono::high_resolution_clock> a, b;    void
start() { a = chrono::high_resolution_clock::now(); }    void stop() {
b = chrono::high_resolution_clock::now(); }    double duration()    { 
      chrono::duration<double> elapsed_seconds = b - a;        return
elapsed_seconds.count();    }}; void fill(vector<string> &list, int
size, double d) {    list.clear();    list.resize(size);    for (int
i=0; i<size; i++)        list[i] =
to_string(rand()%((int)(size*d)));} int main() {    int size = 1024; 
 double d = 100;    vector<string> list;    do{        fill(list,
size, d);        stopwatch st;        st.start();       
sort(list.begin(), list.end());        st.stop();        cout <<
st.duration()*1e9/ log2(size)/size << endl;        size *= 2;   
}while(size<=4*1024*1024);    cout << "end" <<endl;    return
0;} d=100

16.7077
15.6237
16.1659
14.5625
13.7777
15.116
13.3096
13.6631
13.0391
12.9087
12.9574
12.8193
12.6872
end

d=0.01, even faster!

8.36992
10.4783
10.5804
10.4236
9.90457
9.99056
9.80442
9.87245
9.76277
9.91909
9.97854
10.568
10.2577
end


FPC is several times slower, but fatal is in form application.
I make thread , but it is not important, the same is in main thread,
except that thread allows convenient view results, when process not
yet finished
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
timeSort; {$mode objfpc}{$H+}{$define UseCThreads} uses  {$IFDEF
UNIX}{$IFDEF UseCThreads}  cthreads,cmem,  {$ENDIF}{$ENDIF} 
Interfaces, // this includes the LCL widgetset  Forms, Unit1  { you
can add units after this }; {$R *.res} begin 
RequireDerivedFormResource:=True;  Application.Scaled:=True; 
Application.Initialize;  Application.CreateForm(TForm1, Form1); 
Application.Run;end. and
Code: Text  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i object
Form1: TForm1  Left = 248  Height = 240  Top = 131  Width = 320 
Caption = 'Form1'  ClientHeight = 240  ClientWidth = 320  OnCreate =
FormCreate  LCLVersion = '2.0.12.0'  object Button1: TButton    Left =
76    Height = 25    Top = 22    Width = 75    Caption = 'Button1'   
OnClick = Button1Click    TabOrder = 0  end  object Memo1: TMemo   
Left = 16    Height = 130    Top = 96    Width = 296    Lines.Strings
= (      'Memo1'    )    ScrollBars = ssAutoBoth    TabOrder = 1 
endend and
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, StdCtrls,Math; type   { TForm1 }   TForm1
= class(TForm)    Button1: TButton;    Memo1: TMemo;    procedure
Button1Click(Sender: TObject);  private  public  end; var  Form1:
TForm1; implementation uses Linux, unixtype; {$R *.lfm} type   {
TTestThread }   TTestThread = class(TThread)  protected    fToMemo:
string;    procedure AddToMemo;    procedure Execute; override; 
public    constructor Create();  end; { TTestThread } procedure
fill(list: TStringList; size: integer; d: double);var  i,n:
integer;begin  list.Clear;  for i:=0 to size-1 do  begin   
n:=Random(round(size*d));    list.Add(IntToStr(n)); 
end;end; procedure TTestThread.Execute;const c1e9 =
1000*1000*1000;var  tp1,tp2: ttimespec;  t1,t2: int64; 
list:TStringList;  size: integer;  d: double;begin 
list:=TStringList.Create;  size:=1024;  d:=100;  repeat     Fill(list,
size, d);     clock_gettime(CLOCK_MONOTONIC, @tp1);     list.sort(); 
  clock_gettime(CLOCK_MONOTONIC, @tp2);   
 t1:=tp1.tv_nsec+tp1.tv_sec*c1e9;   
 t2:=tp2.tv_nsec+tp2.tv_sec*c1e9;     fToMemo :=
FloatToStr((t2-t1)/Math.Log2(size)/size);   
 synchronize(@AddTOMemo);     size:=size*2;  until size>4*1024*1024; 
list.Free;  fToMemo := 'end'; 
synchronize(@AddTOMemo);end; constructor TTestThread.Create();begin 
inherited Create(false);  FreeOnTerminate:=true;end; procedure
TTestThread.AddToMemo;begin  Form1.Memo1.Lines.Add(fToMemo);end; {
TForm1 } procedure TForm1.Button1Click(Sender: TObject);var  thread:
TTestThread;begin  thread:=TTestThread.Create(); 
thread.Start;end; end. Results for d=100 (aggressive optimization)

1955.9984375
1255.27476917614
505.58701578776
459.529766376202
486.121451241629
512.559214274089
517.353302955627
561.423980712891
604.507530212402
642.564016342163
644.596619796753
697.545514220283
716.581226251342
end

and for d=0.01

3564.07783203125
1221.64275568182
1036.1786702474
995.541672926683
1013.31421334403
1049.10948689779
1012.10831642151
1034.92465344597
1054.99673144023
1066.52670609324
1088.22270264626
1120.13203434717
1127.15126429905
end

Horrible slow!
So worst, BeginUpdate/EndUpdate
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i    
 list.BeginUpdate;     list.sort();     list.EndUpdate;  not helps....

----------------------------------------------------------------------
avk · 2022-05-02 14:41

Perhaps one reason could be that TStringList uses AnsiCompareText() as
its default comparator, which, if I'm not mistaken, calls
Utf8CompareText() under the hood in LCL applications.
What happens if you add
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i begin 
list:=TStringList.Create;  list.UseLocale := False; // <---  ...

----------------------------------------------------------------------
Borneq · 2022-05-02 17:38

Nothing happen in console program, but very speedup for Application  -
now is time as console. Thanks.

----------------------------------------------------------------------
paweld · 2022-05-02 19:35

use generics, eg. Generics.Collections or LGenerics (
https://github.com/avk959/LGenerics )

----------------------------------------------------------------------
Warfley · 2022-05-04 18:43

The difference between FPC and C++ is to be expected. The major
difference here is that the FPC version uses function pointers for
both comparison, but also swapping. C++ on the other hand takes the
comparator as template parameter and does the swapping using
std::move. Both of these calls can be inlined.

For example:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
Project1; {$mode objfpc}{$H+} uses  SysUtils; type  TIntArray = Array
of Integer;  TLessFunc = function(A, B: Integer): Boolean;  TSwapFunc
= procedure(var A, B: Integer); function Less(A, B: Integer): Boolean;
inline;begin  Result := A < B;end; procedure Swap(var A, B: Integer);
inline;begin  A := A Xor B;  B := B Xor A;  A := A Xor
B;end; procedure BubbleSortFP(data: TIntArray; LessFunc: TLessFunc;
SwapFunc: TSwapFunc);var  i, j: Integer;begin  for i := 1 to
Length(data) - 1 do    for j := 0 to Length(data) - 1 - i do      if
LessFunc(data[j + 1], data[j]) then SwapFunc(data[j], data[j +
1]);end; procedure BubbleSortInline(data: TIntArray);var  i, j:
Integer;begin  for i := 0 to Length(data) - 1 do    for j := 0 to
Length(data) - 2 - i do      if Less(data[j + 1], data[j]) then
Swap(data[j], data[j + 1]);end; var  data: Array of Integer;  i:
Integer;  Start: QWord;begin  SetLength(data, 10000);   for i:=0 to
length(data) -1 do    data[i] := Random(Integer.MaxValue);  Start :=
GetTickCount64;  BubbleSortFP(data, @Less, @Swap);  WriteLn('FuncPtr:
', GetTickCount64 - Start);   // Refill array with new numbers to
"fool" predictive caching of CPU  for i:=0 to length(data) -1 do   
data[i] := Random(Integer.MaxValue);  Start := GetTickCount64; 
BubbleSortInline(data);  WriteLn('Inline: ', GetTickCount64 - Start); 
ReadLn;end. On my machine the BubbleSortFP takes around double the
time the inlined version BubbleSortInline does, just by passing
function pointers.

Generally speaking, the classes in the RTL (or generally most parts of
the RTL) are not optimised for performance. Plus generally are most
C++ compilers much better at optimisation than the FPC.

PS: what this example also wonderfully demonstrates is the power of
predictive caching, remove the second filling of the array with new
random values and you will see a major speedup on many modern CPU, on
mine its like 4x