Author Topic: function ScriptCoreQuickSort(List: TStringList; Separator: string; SortingDirect  (Read 136 times)

0 Members and 1 Guest are viewing this topic.

Offline soldat-game

  • Camper
  • ***
  • Posts: 380
function ScriptCoreQuickSort(List: TStringList; Separator: string; SortingDirection:boolean): TStringList;
List - TStringList data
Separator - How the number was separated from the main characters. Example can be "#9"
SortingDirection - False is from highest to lowest, true is lowest to highest.

Remember that the number by which sorting is to be was at the beginning of the string.

x5000 in test:
[ScriptCoreQuickSortAllIn] Sorting batle: 02,320s
[QuickSort4] Sorting batle: 03,374s (Here manually entered the quantity length of the number string without calculation in addition there is no convenience in setting the sorting direction)
Code for test be on down.

Full Code Here:
https://pastebin.com/4QF0FYhY

All in one:
Code: [Select]
function ScriptCoreQuickSortAllIn(List: TStringList; Separator: string; SortingDirection:boolean): TStringList;
var i,b: int64; TempLen, NumCounterMax: byte; ForTest: TStringList; TempString: String;
begin
if List.Count > 0 then begin
ForTest := File.CreateStringList();
for i := 0 to List.Count-1 do begin
ForTest.Append(GetPieceSC3(List[i],Separator,0));
TempLen := Length(ForTest[i]);
if TempLen > NumCounterMax then NumCounterMax := TempLen;
end;
for i := 0 to List.Count-1 do begin
TempString := ForTest[i];
for b:= 1 to NumCounterMax - length(ForTest[i]) do TempString := '0' + TempString;
List[i] := TempString+Copy(List[i],Length(ForTest[i]+Separator),Length(List[i]));
end;
ForTest.Free;
With List do
try
BeginUpdate;
List.Sort;
if SortingDirection then begin
for i := 0 to List.Count-1 do begin
TempLen := Length(List[i]);
for b := 1 to TempLen do begin
TempString := List[i];
if TempString[b] = '0' then continue else
begin
List[i] := Copy(TempString,b,TempLen);
break;
end;
end;
end;
end else
begin
for i := 0 to List.Count-1 do begin
TempLen := Length(List[i]);
for b := 1 to TempLen do begin
TempString := List[i];
if TempString[b] = '0' then continue else
begin
List[i] := Copy(TempString,b,TempLen);
break;
end;
end;
List.Move(i, 0);
end;
end;
Result := List;
Finally EndUpdate
end;
end;
end;

or separated auxiliary functions:
Code: [Select]
function GetPieceSC3(Str, Reg: string; Number: Word): string;
var Res: TStringList;
begin
try
Res := File.CreateStringList;
SplitRegExpr(QuoteRegExprMetaChars(Reg), Str, Res);
Result := Res.Strings[Number];
except
Result := '';
finally
Res.Free;
end;
end;

function ZeroFill(S: string; Peak: integer; IsEnabled: boolean): string;
var i, m: integer;
begin
if IsEnabled then begin
m := Peak - length(S);
for i:= 1 to m do S := '0' + S;
    end;
result := S;
end;

function ZeroRemover(s:string):string;
var i, TempLen: integer;
begin
TempLen := Length(s);
for i := 1 to TempLen do begin
if s[i] = '0' then continue else begin
Result := Copy(s,i,TempLen);
exit;
end;
end;
end;

function ScriptCoreQuickSort(List: TStringList; Separator: string; SortingDirection:boolean): TStringList;
var i: int64; TempLen, NumCounterMax: byte; ForTest: TStringList;
begin
if List.Count > 0 then begin
ForTest := File.CreateStringList();
for i := 0 to List.Count-1 do begin
ForTest.Append(GetPieceSC3(List[i],Separator,0));
TempLen := Length(ForTest[i]);
if TempLen > NumCounterMax then NumCounterMax := TempLen;
end;
for i := 0 to List.Count-1 do List[i] := ZeroFill(ForTest[i],NumCounterMax,true)+Copy(List[i],Length(ForTest[i]+Separator),Length(List[i]));
ForTest.Free;
With List do
try
BeginUpdate;
List.Sort;
if SortingDirection then for i := 0 to List.Count-1 do List[i] := ZeroRemover(List[i]) else
begin
for i := 0 to List.Count-1 do begin
List[i] := ZeroRemover(List[i]);
List.Move(i, 0);
end;
end;
Result:=List;
Finally EndUpdate
end;
end;
end;


Code: (Test) [Select]
TimeStart := Now();
for TempIndexID := 1 to 5000 do begin
NUMA.Append('123'+#9+'TESTOWYGRACZ'+#9+'dasdasd 123123');
NUMA.Append('2'+#9+'0012312412'+#9+'asdaq1a sd2123');
NUMA.Append('8'+#9+'dasauto'+#9+'sadasd asdasd');
NUMA.Append('1'+#9+'00manek'+#9+'ssss 555');
NUMA.Append('9'+#9+'truo'+#9+'gggg 333');
NUMA.Append('13'+#9+'misterer'+#9+'asdasdas 677');
NUMA.Append('99'+#9+'0000asdsa'+#9+'666666 1123231');
NUMA.Append('77'+#9+'2nb3epd9fh12'+#9+'1213 44123');
ScriptCoreQuickSortAllIn(NUMA, #9, false);
Numa.Clear;
end;
WriteLn('[new] Sorting batle '+FormatDateTime('ss,zzz', Now()-TimeStart)+'s'); TimeStart := Now();
for TempIndexID := 1 to 5000 do begin
NUMA.Append('123'+#9+'TESTOWYGRACZ'+#9+'dasdasd 123123');
NUMA.Append('2'+#9+'0012312412'+#9+'asdaq1a sd2123');
NUMA.Append('8'+#9+'dasauto'+#9+'sadasd asdasd');
NUMA.Append('1'+#9+'00manek'+#9+'ssss 555');
NUMA.Append('9'+#9+'truo'+#9+'gggg 333');
NUMA.Append('13'+#9+'misterer'+#9+'asdasdas 677');
NUMA.Append('99'+#9+'0000asdsa'+#9+'666666 1123231');
NUMA.Append('77'+#9+'2nb3epd9fh12'+#9+'1213 44123');
QuickSort4(NUMA, 0, NUMA.Count-1, true, #9, 0, 3);
Numa.Clear;
end;
WriteLn('[old] Sorting batle '+FormatDateTime('ss,zzz', Now()-TimeStart)+'s');
« Last Edit: May 01, 2020, 08:36:44 am by soldat-game »