[solved] TStringList Sorting

[Handoko]

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:

111
45
4516
4523
4534
4547
547
999

But what I want is like this:

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.

[bytebites]

https://wiki.freepascal.org/NaturalSort

[Fred vS]

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

[howardpc]

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.

[avk]

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]

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

[Handoko]

Thank you everyone.
I have a collected many suggestions, now examining which one I should use.