Recent

Author Topic: [solved] TStringList Sorting  (Read 370 times)

Handoko

  • Hero Member
  • *****
  • Posts: 3902
  • My goal: build my own game engine using Lazarus
[solved] TStringList Sorting
« on: October 21, 2020, 06:38:53 pm »
Hello fellas, please help me.

I know there are many sorting algorithms but honestly I have never really studied any of them. :-[
https://en.wikipedia.org/wiki/Sorting_algorithm

I have a TStringList with all of the items are numbered strings. The automatic sorted result is:
Quote
111
45
4516
4523
4534
4547
547
999

But what I want is like this:
Quote
45
111
547
999
4516
4523
4534
4547

Writing something that I'm not sure, I rather ask someone to write it for me. Performance is not important because the item count is usually less than a hundred.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     Memo1: TMemo;
  17.     procedure Button1Click(Sender: TObject);
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.lfm}
  26.  
  27. { TForm1 }
  28.  
  29. procedure TForm1.Button1Click(Sender: TObject);
  30. var
  31.   aList: TStringList;
  32.   i: Integer;
  33. begin
  34.   aList := TStringList.Create;
  35.   aList.Sorted := True;
  36.   aList.Append('4516');
  37.   aList.Append('4547');
  38.   aList.Append('4534');
  39.   aList.Append('4523');
  40.   aList.Append('45');
  41.   aList.Append('547');
  42.   aList.Append('999');
  43.   aList.Append('111');
  44.   Memo1.Clear;
  45.   for i := 0 to aList.Count - 1 do
  46.     Memo1.Append(aList[i]);
  47.   aList.Free;
  48. end;
  49.  
  50. end.

Below is the screenshot and the downloadable source code.
« Last Edit: October 22, 2020, 07:54:23 pm by Handoko »

bytebites

  • Sr. Member
  • ****
  • Posts: 342
Re: TStringList Sorting
« Reply #1 on: October 21, 2020, 06:47:52 pm »

Fred vS

  • Hero Member
  • *****
  • Posts: 1982
    • StrumPract is the musicians best friend
Re: TStringList Sorting
« Reply #2 on: October 21, 2020, 06:55:50 pm »
Hello.

Afaik, with a TStringList, it will be difficult to sort numbers in a "numbers" way.

I do this as work-around, adding '  ' (space) before the numbers.

Example (only the idea that will work if StrNum > 0):

Code: Pascal  [Select][+][-]
  1.  MaxChar := 10;
  2.  
  3.   for i := 0 to NumCharCount do
  4.   begin
  5.    ....
  6.     z := Length(theStrNum[i]);
  7.    
  8.     if z < MaxChar then
  9.           for y := 0 to MaxChar - z do
  10.             theStrNum[i] := ' ' + theStrNum[i];
  11.  
  12.      aList.Append(theStrNum[i]);
  13.    ...
  14.     end;

This will work because  '       987' is <  '      1234';

Fre;D
« Last Edit: October 21, 2020, 07:40:48 pm by Fred vS »
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

howardpc

  • Hero Member
  • *****
  • Posts: 3580
Re: TStringList Sorting
« Reply #3 on: October 21, 2020, 07:26:55 pm »
For reasonably small numbers of string-numbers, you can do this without sorting at all.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, StdCtrls;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     Memo1: TMemo;
  13.     SortNumericalButton: TButton;
  14.     procedure FormCreate(Sender: TObject);
  15.     procedure SortNumericalButtonClick(Sender: TObject);
  16.   private
  17.     procedure PopulateMemo;
  18.     procedure SortMemoNumerically(aMemo: TMemo);
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure TForm1.FormCreate(Sender: TObject);
  33. begin
  34.   PopulateMemo;
  35. end;
  36.  
  37. procedure TForm1.PopulateMemo;
  38. begin
  39.   Memo1.Clear;
  40.   Memo1.Append('4516');
  41.   Memo1.Append('4547');
  42.   Memo1.Append('4534');
  43.   Memo1.Append('4523');
  44.   Memo1.Append('45');
  45.   Memo1.Append('547');
  46.   Memo1.Append('999');
  47.   Memo1.Append('111');
  48. end;
  49.  
  50. procedure TForm1.SortMemoNumerically(aMemo: TMemo);
  51. var
  52.   mn, mx, si: SizeInt;
  53.   arr: array of SizeInt;
  54.   sl: TStringList;
  55.   i, hi, tmp: Integer;
  56.  
  57.   function InArray: Boolean;
  58.   var
  59.     j: Integer;
  60.   begin
  61.     for j := 0 to hi do
  62.       case (arr[j] = si) of
  63.         True: Exit(True);
  64.         False: ;
  65.       end;
  66.     Result := False;
  67.   end;
  68.  
  69. begin
  70.   SetLength(arr{%H-}, aMemo.Lines.Count);
  71.   hi := High(arr);
  72.   sl := TStringList.Create;
  73.   mn := MaxInt;
  74.   mx := -MaxInt;
  75.   try
  76.     for i := 0 to hi do
  77.       case TryStrToInt(aMemo.Lines[i], tmp) of
  78.         True: begin
  79.                 arr[i] := tmp;
  80.                 if mn > tmp then
  81.                   mn := tmp
  82.                 else
  83.                 if mx < tmp then
  84.                   mx := tmp;
  85.               end;
  86.         False: arr[i] := -MaxInt;
  87.       end;
  88.  
  89.     i := 0;
  90.     for si := mn to mx do
  91.       if InArray then
  92.         begin
  93.           sl.Add(si.ToString);
  94.           Inc(i);
  95.         end;
  96.  
  97.     aMemo.Lines.Assign(sl);
  98.   finally
  99.     sl.Free;
  100.   end;
  101. end;                                
  102.  
  103. procedure TForm1.SortNumericalButtonClick(Sender: TObject);
  104. begin
  105.   SortMemoNumerically(Memo1);
  106. end;
  107.  
  108. end.
« Last Edit: October 22, 2020, 08:24:50 pm by howardpc »

avk

  • Sr. Member
  • ****
  • Posts: 324
    • my self-education project
Re: TStringList Sorting
« Reply #4 on: October 21, 2020, 07:52:01 pm »
The StrUtils unit already contains the NaturalCompareText function. So it is enough to create a comparator like this:
Code: Pascal  [Select][+][-]
  1. function NaturalCompare(aList: TStringList; aIndex1, aIndex2: Integer): Integer;
  2. begin
  3.   Result := NaturalCompareText(aList[aIndex1], aList[aIndex2]);
  4. end;  
  5.  
and pass it to TStringList.CustomSort.

winni

  • Hero Member
  • *****
  • Posts: 1993
Re: TStringList Sorting
« Reply #5 on: October 21, 2020, 08:10:37 pm »
Hi!

I was bothered that the StringGrid only sorts in a lexical and not in a numeric way.

The StringGrid has the event onCompareCells.

There you can interfere.

First you define:

Code: Pascal  [Select][+][-]
  1. Type
  2. TSortType = (SortInt,SortUint, SortFloat,SortString);    
  3.  
  4. var SortArray: array of TSortType;
  5.  

Then you fill the Sortarray according to your columns.

Finaly you write  the procedure for onCompareCells.

Code: Pascal  [Select][+][-]
  1. procedure TForm1.StringGrid1CompareCells(Sender: TObject; ACol, ARow, BCol,
  2.  BRow: Integer; var Result: integer);
  3. var  SortTag: TSortType;
  4.  
  5. begin
  6. result := 0;
  7. SortTag := SortArray[ACol];
  8. with StringGrid1 do
  9.    begin
  10.      case SortTag of
  11.        SortInt :result := StrToInt64Def(Cells[ACol,ARow],0)-StrToInt64Def(Cells[BCol,BRow],0);
  12.        SortUint :result := StrToQWordDef(Cells[ACol,ARow],0)-StrToQwordDef(Cells[BCol,BRow],0);
  13.        SortFloat :result := round(StrToFloatDef(Cells[ACol,ARow],0)-StrToFloatDef(Cells[BCol,BRow],0));
  14.        SortString:result := UTF8CompareStr(Cells[ACol,ARow], Cells[BCol,BRow]);
  15.      end; // case
  16.   if SortOrder = soDescending then result := -result;
  17. end;// with
  18. end;            
  19.  
  20.  

The result of StringGrid1CompareCells is given into a Quicksort.
And this is quick as hell.
Below 10.000 rows you wont notice a delay.

Winni
« Last Edit: October 21, 2020, 08:12:19 pm by winni »

Handoko

  • Hero Member
  • *****
  • Posts: 3902
  • My goal: build my own game engine using Lazarus
Re: TStringList Sorting
« Reply #6 on: October 22, 2020, 07:53:51 pm »
Thank you everyone.
I have a collected many suggestions, now examining which one I should use.

 

TinyPortal © 2005-2018