Official Soldat Forums
Server Talk => Scripting Releases => Topic started by: CurryWurst on July 21, 2008, 02:28:33 pm
-
Script Name: QuickSort
Script Description: QuickSort - a very fast sort algorithm by using the principle "Divide & Conquer".
Original Author(s): Markus "Dual" Quär
Core Version: 2.6.3
This script allows you to sort integer as well as string arrays.
You can easily change the sort direction by swapping the relational operator "<, >" in the following two lines of code:
1. while (Field[l] > Pivot) do
2. while (Field[r] < Pivot) do
Note: Default sort direction is in descending order.
Explanation of arguments (Thx for asking iDante):
Field - the array you would like to sort
Left - the first element of the array (actually it's always zero by dynamic arrays)
Right - the last element of the array (use ArrayHigh(YourArray) or GetArrayLength(YourArray) - 1 to get the highest possible element)
SortBy:
-------
Especially intended for my script, but i can explain it too ... you can use it, if each of your elements contains separated values for example the element[0] contains:'value1 Delimiter value2 Delimiter value3' and so on ... the other elements must contain the same structure as the first one.
If this condition is given, you can easily decide which of the values you like to use as compare value by setting the var SortBy to the position the compare value is located (Note: In my case, a tabulator is my delimiters, you can choose your own one by changing every "#9" brick to your delimiter). The pick of the bunch is, that every value can be a different type, so you can sort integers using an array of string :)
Here we go ...
/////////////////
Integer sort:
/////////////////
// Divide & Conquer :P
procedure QuickIntegerSort(var Field: array of integer; Left, Right: integer);
var
l, r, Buffer, Pivot: integer;
begin
// Chek whether there is at least more than one element to sort
if (Left < Right) then
begin
l:= Left;
r:= Right;
// Pick the Pivot element
Pivot:= Field[(Left + Right) shr 1];
// Presort
repeat
// Search an element which is smaller than the piviot
while (Field[l] > Pivot) do
begin
Inc(l, 1);
end;
// Search an element which is greater than the pivot
while (Field[r] < Pivot) do
begin
Dec(r, 1);
end;
// Swap the greater element with the smaller one
if (l <= r) then
begin
Buffer:= Field[r];
Field[r]:= Field[l];
Field[l]:= Buffer;
Inc(l, 1);
Dec(r, 1);
end;
until (l >= r);
if (Left < r) then
begin
QuickIntegerSort(Field, Left, r);
end;
if (Right > l) then
begin
QuickIntegerSort(Field, l, Right);
end;
end else
begin
exit;
end;
end;
////////////////
String sort:
////////////////
procedure QuickStringSort(var Field: array of string; Left, Right: integer);
var
l, r: integer;
Pivot, Buffer: string;
begin
// Check whether there is at least more than one element to sort
if (Left < Right) then
begin
l:= Left;
r:= Right;
// Pick the Pivot element
Pivot:= Field[(Left + Right) shr 1];
// Presort
repeat
// Search an element which is smaller than the piviot
while (Field[l] > Pivot) do
begin
Inc(l, 1);
end;
// Search an element which is greater than the pivot
while (Field[r] < Pivot) do
begin
Dec(r, 1);
end;
// Swap the greater element with the smaller one
if (l <= r) then
begin
Buffer:= Field[r];
Field[r]:= Field[l];
Field[l]:= Buffer;
Inc(l, 1);
Dec(r, 1);
end;
until (l >= r);
if (Left < r) then
begin
QuickStringSort(Field, Left, r);
end;
if (Right > l) then
begin
QuickStringSort(Field, l, Right);
end;
end else
begin
exit;
end;
end;
I'm using a combination of both to sort a TStringArray by different variable types.
It will be implemented in my upcoming project calling "LogInSystem" :D
Here is a proper look at my development:
procedure QuickSort(var Field: array of string; Left, Right: integer; SortBy: integer); // Thanks DorkeyDear for your note
var
l, r: integer;
Pivot, Buffer: string;
begin
if (Left < Right) then
begin
l:= Left;
r:= Right;
Pivot:= GetPiece(Field[(Left + Right) shr 1], #9, SortBy);
repeat
while (GetPiece(Field[l], #9, SortBy) > Pivot) do
begin
Inc(l, 1);
end;
while (GetPiece(Field[r], #9, SortBy) < Pivot) do
begin
Dec(r, 1);
end;
if (l <= r) then
begin
Buffer:= Field[r];
Field[r]:= Field[l];
Field[l]:= Buffer;
Inc(l, 1);
Dec(r, 1);
end;
until (l >= r);
if (Left < r) then
begin
QuickSort(Field, Left, r, SortBy);
end;
if (Right > l) then
begin
QuickSort(Field, l, Right, SortBy);
end;
end else
begin
exit;
end;
end;
For more information visit http://en.wikipedia.org/wiki/Quicksort (http://en.wikipedia.org/wiki/Quicksort). ;)
-
Well, sorry, but, how is it useful?
-
It would be a efficient method of sorting arrays of strings or integeres.. That is, if it would work. I wonder if you tried to compile this and tested it out in your project. There are a few things I notice when i quickly go over the script:
You can input an array in the procedure, but nothing will come out. It looks as if you think that an 'array of String/Integer' is a pointer, but it's not. I think you will need to make a function out of it, one that will return the sorted array.
The procedure will call itself in the process. I'm not sure if that's possible, actually.. Is it?
I'm using a combination of both to sort a TStringArray by different variable types.
It will be implemented in my upcoming project calling "LogInSystem" :D
I really wonder what you mean here. AFAIK a TStringArray is not much different as an Array of String... again: Is it?
Besides that it looks like an interesting part of code, also nice you like beer...
-
Well, sorry, but, how is it useful?
I'm using it to sort user data by names, kills, deaths etc... for example. You can use QuickSort for every aspect when you want to sort a big amount of data in short time ;)
-
Dang man, this is wicked awesome! Definitly usful for charts and tables and stuff. Possibly could be used w/ my Table function to draw tables organized in any way on ppl''s consoles. Good job!
EDIT: using tstringarray instead of array of string slightly slows down the function, which can be bad for larger arrays.
-
You can input an array in the procedure, but nothing will come out. It looks as if you think that an 'array of String/Integer' is a pointer, but it's not. I think you will need to make a function out of it, one that will return the sorted array.
You have got it :D There shouldn't be an output, you can access on it by accessing on your array, but if you really like an output write a little workaround - you simply need a loop which writes each array element in line of a file.
The procedure will call itself in the process. I'm not sure if that's possible, actually.. Is it?
Yes, that's possible.
I'm using a combination of both to sort a TStringArray by different variable types.
It will be implemented in my upcoming project calling "LogInSystem" :D
I really wonder what you mean here. AFAIK a TStringArray is not much different as an Array of String... again: Is it?
On the one hand you're absolutely right - I mean the sens of my sentences, but on the other hand I tried to express the way I'm doing my workaround by using a TSringArray for string content as well as integer vars. You will undertand what I mean, when I release my LogInSystem :)
Besides that it looks like an interesting part of code, also nice you like beer...
Thanks man =)
Date Posted: July 21, 2008, 07:20:07 pm
Dang man, this is wicked awesome! Definitly usful for charts and tables and stuff. Possibly could be used w/ my Table function to draw tables organized in any way on ppl''s consoles. Good job!
Yea yea yea, that's the way I'm using it! - I will post my table procedure later :)
EDIT: using tstringarray instead of array of string slightly slows down the function, which can be bad for larger arrays.
Oh didn't know that before, I'm really thankful for your note! I will fix my code as soon as possible.
-
Could you explain the args?
procedure QuickSort(var Field: array of string; Left, Right: integer; SortBy: integer);
I get Field, but what do Left, Right, and SortBy mean?
-
Could you explain the args?
procedure QuickSort(var Field: array of string; Left, Right: integer; SortBy: integer);
I get Field, but what do Left, Right, and SortBy mean?
Okay. First of all use one of the codes above, so Integer sort or rather String sort, because the one you're asking for is a special QuickSort optimized for my own script, but if you are able to handle it, feel free to use it.
See #1 post for more information ;)
-
Relating to the SortBy value, i suggest having two inputs, a delimiter string, along with the number of delimiter passes (that one getpiece number), but -1 = whole string though
EDIT: is there a choice for ascending or descending? I suggest having a boolean input for descending if true
-
Relating to the SortBy value, i suggest having two inputs, a delimiter string, along with the number of delimiter passes (that one getpiece number), but -1 = whole string though
EDIT: is there a choice for ascending or descending? I suggest having a boolean input for descending if true
That's quite a good idea. I've implemented this idea in another function I made, therefore it won't be hard to figure out how to implement it.
I thought about having a choice to decide, whether the sort algorithm sorts in ascending or descending order too. I will code it in combination with Median-of-three :)
Edit: Do you mean that I still have to use GetPiece and adding the exception - 1 = whole string or do I have to implement my own loop catching all the split points and then using the value which comes before the split point as compare value?
I think you mean something like this?! (Note: This is just an example):
Edit: Added support for altering the sort order.
Edit: Minor bugfixes
// Divide & conquer in order you would like to sort:P
procedure QuickSort(var Field: array of string; Left, Right, SortBy: integer; Delimiter: string; DescendingOrder: boolean);
var
l, r: integer;
Pivot, Buffer, CompareValueL, CompareValueR: string;
begin
// Chek whether there is at least more than one elment to sort
if (Left < Right) then
begin
l:= Left;
r:= Right;
if (SortBy <= 0) then
begin
CompareValueL:= Field[l];
CompareValueR:= Field[r];
// Pick the Pivot element
Pivot:= Field[(Left + Right) shr 1];
end else
begin
CompareValueL:= GetPiece(Field[l], Delimiter, SortBy);
CompareValueR:= GetPiece(Field[l], Delimiter, SortBy);
// Pick the Pivot element
Pivot:= GetPiece(Field[(Left + Right) shr 1], Delimiter, SortBy);
end;
repeat
if (DescendingOrder = true) then
begin
// Search an element which is smaller than the piviot
while (CompareValueL > Pivot) do
begin
Inc(l, 1);
end;
// Search an element which is greater than the pivot
while (CompareValueR < Pivot) do
begin
Dec(r, 1);
end;
end else
begin
// Search an element which is greater than the pivot
while (CompareValueL < Pivot) do
begin
Inc(l, 1);
end;
// Search an element which is smaller than the pivot
while (CompareValueR > Pivot) do
begin
Dec(r, 1);
end;
end;
// Swap the greater element with the smaller one
if (l <= r) then
begin
Buffer:= Field[r];
Field[r]:= Field[l];
Field[l]:= Buffer;
Inc(l, 1);
Dec(r, 1);
end;
until (l >= r);
if (Left < r) then
begin
QuickSort(Field, Left, r, SortBy, Delimiter, DescendingOrder);
end;
if (Right > l) then
begin
QuickSort(Field, l, Right, SortBy, Delimiter, DescendingOrder);
end;
end else
begin
exit;
end;
end;
-
Edit: Do you mean that I still have to use GetPiece and adding the exception - 1 = whole string
Yes
-
I updated the script. It's much more reliable and can handle strings representing numeric values.
Set Ival to true if you want to sort strings representing numeric values.
Here we go...
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
begin
S:= '0' + S;
end;
end;
result:= S;
end;
function QuickSort(var AOS: array of string; Left, Right: integer; Ival: boolean): integer;
var
b, e, Pivot: string;
i, l, m, r: integer;
begin
if (Right > Left) then
begin
for i:= 0 to Right do
begin
if (length(AOS[i]) > m) then
begin
m:= length(AOS[i]);
end;
end;
l:= Left;
r:= Right;
Pivot:= ZeroFill(AOS[Random(Left, Right)], m, Ival);
repeat
while ((ZeroFill(AOS[l], m, IVal) > Pivot) and (l < Right)) do
begin
Inc(l, 1);
end;
while ((ZeroFill(AOS[r], m, IVal) < Pivot) and (r > Left)) do
begin
Dec(r, 1);
end;
if (l <= r) then
begin
b:= AOS[r];
AOS[r]:= AOS[l];
AOS[l]:= b;
Inc(l, 1);
Dec(r, 1);
Inc(Result, 1);
end;
until (l >= r);
if (Left < r) then
begin
QuickSort(AOS, Left, r, Ival);
end;
if (Right > l) then
begin
QuickSort(AOS, l, Right, Ival);
end;
end else
begin
exit;
end;
end;
Feel free to use this function in your script :)
-
Should be externalized.. Performs unnecessary calculations over and over again. Calculate how many characters the number contains on the basis of which the table is to be sorted
for i:= 0 to Right do
begin
if (length(AOS[i]) > m) then
begin
m:= length(AOS[i]);
end;
end;
Here is my version with getpiece implementation and a separate parameter
function QuickSort4(var AOS: TStringList; const Left, Right: integer; Ival: boolean; Separator:String; SortBy, m: integer): integer;
var b, Pivot: string; l, r: integer;
begin
if Right > Left then begin
l := Left; r := Right;
Pivot := ZeroFill(GetPieceSC3(AOS[Random(Left, Right)], Separator, SortBy), m, Ival);
repeat
while (ZeroFill(GetPieceSC3(AOS[l], Separator, SortBy), m, IVal) > Pivot) and (l < Right) do Inc(l, 1);
while (ZeroFill(GetPieceSC3(AOS[r], Separator, SortBy), m, IVal) < Pivot) and (r > Left) do Dec(r, 1);
if l <= r then begin
b := AOS[r];
AOS[r] := AOS[l]; AOS[l] := b;
Inc(l, 1); Dec(r, 1); Inc(Result, 1);
end;
until l >= r;
if Left < r then QuickSort4(AOS, Left, r, Ival, Separator, SortBy, m);
if Right > l then QuickSort4(AOS, l, Right, Ival, Separator, SortBy, m);
end else exit;
end;
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
finally
Res.Free;
end;
end;
function optimizing the calculation of how many characters a number contains
function CaseTbl(Z: Int64): Int64;
begin
case Z of
0..9: Result := 1;
10..99 : Result := 2;
100..999: Result := 3;
1000..9999: Result := 4;
10000..99999: Result := 5;
100000..999999: Result := 6;
1000000..9999999: Result := 7;
10000000..99999999: Result := 8;
100000000..999999999: Result := 9;
1000000000..9999999999: Result := 10;
10000000000..99999999999: Result := 11;
100000000000..999999999999: Result := 12;
1000000000000..9999999999999: Result := 13;
10000000000000..99999999999999: Result := 14;
100000000000000..999999999999999: Result := 15;
1000000000000000..9999999999999999: Result := 16;
10000000000000000..99999999999999999: Result := 17;
100000000000000000..999999999999999999: Result := 18;
1000000000000000000..9223372036854775807: Result := 19;
end;
end;
As we have added zeros, we can remove them: yes I know there is no need here but it will be useful for other purposes as if someone needed)
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;
-
Ancient thread.. but I think this would be better implemented within object pascal itself (or embedded as a .so) rather than as part of a soldat script
-
function ScriptCoreQuickSort(List: TStringList; Separator: string; SortingDirection:boolean): TStringList;
List - TStringList
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:
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:
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;
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');