My TStringList custom SORTing, trying to mimic Windows Explorer way

[programmerdelphi2k 237]

Please don't be harsh with the comments...

 

• The principle is to identify the digits (numbers) contained in the text, add a bunch of "zeros" (to imitate the conversion into numerical values, but avoiding an "overflow" if using any text-to-number conversion function) and then represent them as their numerical value through the "ORD()" function.
• In this way, we avoid a possible "overflow exception", and we will be able to compare the strings (re-created for comparison purposes only) that are stored in a StringList or similar...

 

I don't know if I managed to explain it well, but it needs testing... maybe in other languages.

 

 

unit uMyTools;

interface

function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string;
function MyReCreatingMyString(AString: string): string;

implementation

uses
  System.SysUtils,
  System.StrUtils;

const
  LMyDigits: TSysCharSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];

function MyNormalizeString(AStr: string; ASizeValue: byte = 10): string;
var
  LStr: string;
  LVal: string;
  LEnd: integer;
begin
  LStr := '';
  LVal := '';
  LEnd := AStr.Length;
  //
  if not(ASizeValue in [10 .. 20]) then
    ASizeValue := 10;
  //
  for var i: integer := 1 to LEnd do
    begin
      if CharInSet(AStr[i], LMyDigits) then
        begin
          LVal := LVal + AStr[i];
          //
          if ((i + 1) <= LEnd) then
            begin
              if not(CharInSet(AStr[i + 1], LMyDigits)) then
                begin
                  LStr := LStr + DupeString('0', ASizeValue - LVal.Length) + LVal;
                  LVal := '';
                end;
            end;
        end
      else
        begin
          LStr := LStr + AStr[i];
        end;
    end;
  //
  if not LVal.IsEmpty then
    LVal := DupeString('0', ASizeValue - LVal.Length) + LVal;
  //
  result := LStr + LVal;
end;

function MyReCreatingMyString(AString: string): string;
var
  LStr: string;
begin
  result := '';
  //
  LStr := MyNormalizeString(AString);
  //
  for var C in LStr do
    begin
      if CharInSet(C, LMyDigits) then
        result := result + ord(C).ToString
      else
        result := result + C;
    end;
end;

end.

 

Testing....

 

implementation

{$R *.dfm}

uses
  uMyTools;

function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer;
var
  LCLeft, LCRight  : string;
  CmpLeft, CmpRight: string;
begin
  LCLeft  := LowerCase(SL[ALeft]);
  LCRight := LowerCase(SL[ARight]);
  //
  CmpLeft  := MyReCreatingMyString(LCLeft);
  CmpRight := MyReCreatingMyString(LCRight);
  //
  result := CompareStr(CmpLeft, CmpRight);
  //
  if (result = 0) then
    result := CompareStr(LCLeft, LCRight);
end;

procedure TForm1.Btn_CustomSortClick(Sender: TObject);
var
  SL: TStringList;
begin
  Memo1.Lines.Clear;
  //
  SL := TStringList.Create;
  try
    SL.Sorted     := false;
    SL.Duplicates := TDuplicates.dupAccept;
    //
    SL.Add('Delphi1World1Hello Windows'); // 1 space
    SL.Add('hello2');
    SL.Add('hello10');
    SL.Add('hello1');
    SL.Add('hello4');
    SL.Add('delphi  2'); // 2 spaces
    SL.Add('hello 000'); // 1 space
    SL.Add('delphi');
    SL.Add('hello3');
    SL.Add('Delphi3 World2023'); // 1 space
    SL.Add('Custom');
    SL.Add('delphi 2');            // 1 space
    SL.Add('Delphi1.5World10 11'); // 1.5 - 1 space
    SL.Add('World');
    SL.Add('Delphi 1'); // 1 space
    SL.Add('A B C');    // 1 space + 1 space
    SL.Add('hello000'); // 0 space
    SL.Add('abc');
    SL.Add('delphi 2'); // 1 space
    SL.Add('');         // EMPTY!!!
    SL.Add('Delphi10');
    SL.Add('Delphi1');
    SL.Add('Delphi13');
    SL.Add('Delphi1.5World10 21'); // 1.5 - 1 space
    SL.Add('Delphi001');
    SL.Add('Delphi3');
    SL.Add('Delphi3World2023');
    SL.Add('Delphi3 Hi!');                  // 1 space
    SL.Add('Delphi 5');                     // 1 space
    SL.Add('Delphi1.2World1Hello Windows'); // 1 space
    SL.Add('Delphi2');
    SL.Add('Delphi01');
    SL.Add('Delphi 3World2023'); // 1 space
    SL.Add('Delphi 1');          // 1 space
    SL.Add('Delphi12');
    SL.Add('Delphi4');
    SL.Add('Delphi2.5World2022'); // 2.5
    SL.Add('Hello3.5');
    //
    SL.CustomSort(@MyStringListCustomSort);
    //
    Memo1.Lines.AddStrings(SL);
  finally
    SL.Free;
  end;
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

 

Edited June 23, 2023 by programmerdelphi2k

[Anders Melander 1782]

It's called "Natural" sort order.

Explorer probably uses StrCmpLogicalW but there's also CompareStringEx with SORT_DIGITSASNUMBERS?

 

See also: Sorting for Humans : Natural Sort Order

[David Heffernan 2345]

It would be cool to look at the Wine implementation of StrCmpLogicalW and port that to Pascal once and for all for a cross platform implementation.

 

https://gitlab.winehq.org/wine/wine/-/blob/master/dlls/kernelbase/string.c#L1298

 

Looks kinda simple really

Edited June 23, 2023 by David Heffernan

[programmerdelphi2k 237]

I think that no really needs "MyReCreatingMyString( ... )" at all...    you can delete it!!!

• Now, let's study "Natural Sort Order..." ...  🙂 

 

unit uMyTools;

interface

function MyNormalizeString(AStr: string; AValLength: byte = 10): string;

implementation

uses
  System.SysUtils,
  System.StrUtils;

const
  LMyDigits: TSysCharSet = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];

function MyNormalizeString(AStr: string; AValLength: byte = 10): string;
var
  LStr: string;
  LVal: string;
  LEnd: integer;
begin
  LStr := '';
  LVal := '';
  LEnd := AStr.Length;
  //
  { ex. Text1 and Text1234567890 and Text123456789012345 = part complex!!!  AValLength := ?
    Text0000000001
    Text1234567890
    Text123456789012345
    //
    ... we can have it with distinct length, then we use an arbitrary value!
  }
  if (AValLength < 10) then
    AValLength := 10
  else
    if (AValLength > 20) then
      AValLength := 20;
  //
  for var i: integer := 1 to LEnd do
    begin
      if CharInSet(AStr[i], LMyDigits) then
        begin
          LVal := LVal + AStr[i];
          //
          if ((i + 1) <= LEnd) and not(CharInSet(AStr[i + 1], LMyDigits)) then
            begin
              LStr := LStr + DupeString('0', AValLength - LVal.Length) + LVal;
              LVal := '';
            end;
        end
      else
        LStr := LStr + AStr[i];
    end;
  //
  if not LVal.IsEmpty then
    LVal := DupeString('0', AValLength - LVal.Length) + LVal;
  //
  result := LStr + LVal;
end;

end.

 

function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer;
var
  LCLeft, LCRight  : string;
  CmpLeft, CmpRight: string;
begin
  LCLeft  := LowerCase(SL[ALeft]);
  LCRight := LowerCase(SL[ARight]);
  //
  CmpLeft  := MyNormalizeString(LCLeft);
  CmpRight := MyNormalizeString(LCRight);
  //
  result := CompareStr(CmpLeft, CmpRight);
  //
  if (result = 0) then
    result := CompareStr(LCLeft, LCRight);
end;

 

Edited June 24, 2023 by programmerdelphi2k

[Stefan Glienke 2002]

Every time I see allocations for comparing strings I have to cry

[programmerdelphi2k 237]

5 hours ago, Stefan Glienke said:

Every time I see allocations for comparing strings I have to cry

my intention was not to teach the masters, it was just to expose an idea. Also, because I don't have enough knowledge to debate with MS engineers, even if they provide their own bugs!

 

So, I usually created "each variable" to expose the phases that I take into account, and thus show my elaboration to those who don't have much more knowledge than I do.

 

Naturally, in a production deployment, things won't be coded in this foul way, and, that makes some people cry... (either in anger or in laughter)   

 

maybe this crazy omelete stay better...

function MyStringListCustomSort(SL: TStringList; ALeft, ARight: integer): integer;
begin
  result := CompareStr(MyNormalizeString(LowerCase(SL[ALeft])), MyNormalizeString(LowerCase(SL[ARight])));
  //
  if (result = 0) then
    result := CompareStr(LowerCase(SL[ALeft]), LowerCase(SL[ARight]));
end;

 

Edited June 30, 2023 by programmerdelphi2k