QuickSort Implementation (In-place method)

[CurryWurst]

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
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" 

Here is a proper look at my development:

Code: [Select]

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. 

[Neosano]

Well, sorry, but, how is it useful?

[JFK]

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" 

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...

[CurryWurst]

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 

[DorkeyDear]

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.

[CurryWurst]

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 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" 

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.

[iDante]

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?

[CurryWurst]

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

[DorkeyDear]

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

[CurryWurst]

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

Code: [Select]

// 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; 


[DorkeyDear]

Edit: Do you mean that I still have to use GetPiece and adding the exception - 1 = whole string

Yes

[CurryWurst]

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...

Code: [Select]

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

[soldat-game]

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

Code: [Select]

    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

Code: [Select]

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;

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
finally
Res.Free;
end;
end;
function optimizing the calculation of how many characters a number contains

Code: [Select]

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)

Code: [Select]

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;

[jrgp]

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

[soldat-game]

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:

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');