# Sorting Algorithms

## Recommended Posts

BubbleSort:

Every time it loops through the array, it moves the largest item it can find to the back of unsorted area of the array, it repeats this until all items have been sorted. It moves the largest item to the back until it finds a larger item on the way with which it continues until it's moving the largest item in the array.

```procedure BubbleSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi: Integer;
begin
Hi := High(Arr);
for CurIndex := 0 to Hi do
for TmpIndex := 1 to Hi - CurIndex do
if Arr[TmpIndex - 1] > Arr[TmpIndex] then
Swap(Arr[TmpIndex - 1], Arr[TmpIndex]);
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
BubbleSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

SelectionSort:

Loops through the array, it finds the smallest item in the array and swaps it with the item at it's current index.

```procedure SelectionSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi, Min: Integer;
begin
Hi := High(Arr);
for CurIndex := 0 to Hi do
begin
Min := CurIndex;
for TmpIndex := CurIndex + 1 to Hi do
if Arr[Min] > Arr[TmpIndex] then
Min := TmpIndex;
Swap(Arr[Min], Arr[CurIndex]);
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
SelectionSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

InsertionSort:

Loops through the array, moves every item it encounters up in the array towards the start until it's placed before every larger item that has been encountered so far.

```procedure InsertionSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi, Min: Integer;
begin
Hi := High(Arr);
for CurIndex := 1 to Hi do
for TmpIndex := CurIndex downto 1 do
begin
if not (Arr[TmpIndex] < Arr[TmpIndex - 1]) then
Break;
Swap(Arr[TmpIndex - 1], Arr[TmpIndex]);
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
InsertionSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

MergeSort:

Divides up the array into 2 parts recursively until it can no longer be divided because there's only a single item left in the sub-array. After doing this it recurses back up, merging the 2 sorted sub-arrays by looping through the 2 parts, placing the smallest item currently in either one first in the resulting array. The 2 sub-arrays in the lowest recursion level is always sorted as it contains a single item.

```procedure Merge(var Arr, Aux: TIntArray; const Lo, Mid, Hi: Integer);
var
LHalf, RHalf, Index: Integer;
begin
LHalf := Lo;
RHalf := Mid + 1;

for Index := Lo to Hi do
Aux[index] := Arr[index];

for Index := Lo to Hi do
if LHalf > Mid then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else if RHalf > Hi then
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end else if Aux[RHalf] < Aux[LHalf] then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end;
end;

procedure Sort(var Arr, Aux: TIntArray; const Lo, Hi: Integer);
var
Mid: Integer;
begin
if Lo >= Hi then Exit;

Mid := Lo + (Hi - Lo) div 2;

Sort(Arr, Aux, Lo, Mid);
Sort(Arr, Aux, Mid + 1, Hi);
Merge(Arr, Aux, Lo, Mid, Hi);
end;

procedure MergeSort(var Arr: TIntArray);
var
Len: Integer;
Aux: TIntArray;
begin
Len := Length(Arr);
if Len <= 1 then Exit;
SetLength(Aux, Len);
Sort(Arr, Aux, 0, Len - 1);
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
MergeSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

Bottom-Up MergeSort:

The previous version of MergeSort is the most commonly referenced one, it is a top-down version of the algorithm as it starts at the top of your merging tree, then splits up into 2 smaller sub-arrays and goes on until it can no longer split up the sub-arrays. The bottom-up version does the exact opposite, it starts at the bottom and merges together in groups of 2, then doubles that group size up until everything is sorted, which is achieved when the size of the groups exceeds the size of the array.

```procedure Merge(var Arr, Aux: TIntArray; const Lo, Mid, Hi: Integer);
var
LHalf, RHalf, Index: Integer;
begin
LHalf := Lo;
RHalf := Mid + 1;

for Index := Lo to Hi do
Aux[index] := Arr[index];

for Index := Lo to Hi do
if LHalf > Mid then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else if RHalf > Hi then
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end else if Aux[RHalf] < Aux[LHalf] then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end;
end;

procedure MergeSort(var Arr: TIntArray);
var
Len, Size, Lo: Integer;
Aux: TIntArray;
begin
Len := Length(Arr);
if Len <= 1 then Exit;
SetLength(Aux, Len);

Size := 1;
while Size < Len do
begin
Lo := 0;
while Lo < Len - Size do
begin
Merge(Arr, Aux, Lo, Lo + Size - 1, Min(Lo + Size * 2 - 1, Len - 1));
IncEx(Lo, Size * 2);
end;
IncEx(Size, Size);
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
MergeSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

ShellSort:

A special form of InsertionSort where the based on the size of the input data, the items are swapped to the top of the array the same way as with InsertionSort, but in large jumps which shrinks by dividing it by 3 until it reaches 1 which sorts the remaining array the same way InsertionSort does, however, at this point the array is already sorted to a certain degree, making the work required to finish sorting a lot easier than by running InsertionSort on the entire array.

```procedure ShellSort(var Arr: TIntArray);
var
X, CurIndex, TmpIndex, Len: Integer;
begin
Len := Length(Arr);

X := 0;
while X < Len div 3 do
X := X * 3 + 1;

while X >= 1 do
begin
for CurIndex := X to Len - 1 do
begin
TmpIndex := CurIndex;
while (TmpIndex >= X) and (Arr[TmpIndex] < Arr[TmpIndex - X]) do
begin
Swap(Arr[TmpIndex], Arr[TmpIndex - X]);
DecEx(TmpIndex, X);
end;
end;
X := X div 3;
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
ShellSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

QuickSort:

This algorithm is somewhat similar to MergeSort, it also divides up the problem and solves it recursively. The concept is fairly straightforward. You start with an array, you take the first item of this array and compare it from both left and right to the other items in the array. From the left you want to find an item that is larger or equal to this first value, and from the right smaller or equal. If you find these, you swap them and resume from the current position until you've swapped them to a point where both your positions have crossed each other. What has happened is that you have moved all values larger than the first value to the right and all the ones smaller to the left. When the algorithm stops partitioning, your right position will be at the index where the last smaller value is located. This is swapped with the first value. Now you have this first value in a position where all values left of it are smaller and all values right of it are larger. Now you apply the same function recursively to these 2 sub-arrays of smaller and larger values until you reach a point where you're trying to sort single values which are obviously sorted as there's only 1 value. Once the recursion is complete, the entire array will be sorted.

```function Partition(var Arr: TIntArray; const Lo, Hi: Integer): Integer;
var
LSide, RSide, Val: Integer;
begin
Val := Arr[Lo];
LSide := Lo;
RSide := Hi + 1;

while True do
begin
repeat
Inc(LSide);
if (Val < Arr[LSide]) or (LSide = Hi) then Break;
until False;
repeat
Dec(RSide);
if (Val > Arr[RSide]) or (RSide = Lo) then Break;
until False;
if LSide >= RSide then Break;
Swap(Arr[LSide], Arr[RSide]);
end;

Swap(Arr[RSide], Arr[Lo]);
Result := RSide;
end;

procedure Sort(var Arr: TIntArray; const Lo, Hi: Integer);
var
Mid: Integer;
begin
if Lo >= Hi then Exit;
Mid := Partition(Arr, Lo, Hi);
Sort(Arr, Lo, Mid - 1);
Sort(Arr, Mid + 1, Hi);
end;

procedure QuickSort(var Arr: TIntArray);
begin
Sort(Arr, 0, Length(Arr) - 1);
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
QuickSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

3-Way QuickSort

QuickSort with 3-way partitioning still divides up the array into subarrays like the regular QuickSort algorithm does, however, rather than dividing it up into 2 arrays stretching the entire array, it will split it up into 2 arrays containing all items smaller than the first value of the array and a second larger than this item, all values equal to the first value are moved to the middle and left untouched any further. This process continues recursively until the array is sorted.

```procedure Sort(var Arr: TIntArray; const Lo, Hi: Integer);
var
LSide, RSide, Pos, Val: Integer;
begin
if Lo >= Hi then Exit;
Val := Arr[Lo];
LSide := Lo;
RSide := Hi;
Pos := Lo + 1;

while Pos <= RSide do
if Arr[Pos] < Val then
begin
Swap(Arr[LSide], Arr[Pos]);
Inc(Pos);
Inc(LSide);
end else if Arr[Pos] > Val then
begin
Swap(Arr[RSide], Arr[Pos]);
Dec(RSide);
end else
Inc(Pos);

Sort(Arr, Lo, LSide - 1);
Sort(Arr, RSide + 1, Hi);
end;

procedure QuickSort(var Arr: TIntArray);
begin
Sort(Arr, 0, Length(Arr) - 1);
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
QuickSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

HeapSort:

The HeapSort algorithm first transforms your array into a binary heap by sinking down smaller elements for all nodes that have child nodes in the tree. Next it switches the first element with the last element in the array and decreases the size of the unsorted area by 1. The element now at the top is sunk down the remaining tree which moves the largest element currently present to the top of the tree. Now the process repeats.

```procedure Sink(var Arr: TIntArray; const Idx, LvlEnd, Len: Integer);
var
Tmp, Pos, SwapIdx: Integer;
begin
Pos := Idx;
while Pos <= LvlEnd do
begin
SwapIdx := Pos;
Tmp := Pos * 2 + 1;
if (Arr[Pos] < Arr[Tmp]) then SwapIdx := Tmp;
Inc(Tmp);
if (Tmp < Len) and (Arr[swapIdx] < Arr[Tmp]) then SwapIdx := Tmp;
if SwapIdx <> Pos then
begin
Swap(Arr[swapIdx], Arr[Pos]);
Pos := SwapIdx;
end else Break;
end;
end;

procedure HeapSort(var Arr: TIntArray);
var
Len, Idx, LvlEnd: Integer;
begin
Len := Length(Arr);
LvlEnd := (Len - 1) div 2 - 1;
for Idx := LvlEnd downto 0 do
Sink(Arr, Idx, LvlEnd, Len);
while Len > 0 do
begin
Swap(Arr[0], Arr[Len - 1]);
Dec(Len);
Sink(Arr, 0, (Len - 1) div 2 - 1, Len);
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1];
WriteLn(TIAToStr(TIA));
HeapSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

Edited by Freddy
##### Share on other sites

Nice work with the sorting algorithms, Freddy!

Thanks and cheers for sharing em here.

Are you planning to add SelectionSort, InsertionSort, MergeSort/Bottom-Up MergeSort and HeapSort to the SCAR's default functions in the future?

Would be great to have em built-in! ..pssshtt, maybe for 3.31?...

-Jani

##### Share on other sites

I'm not, most of these have a pretty bad performance compared to ShellSort which SCAR currently uses, the only used that are the same or close in most cases are QuickSort and HeapSort.

##### Share on other sites

Nice to see these posted

##### Share on other sites

I've added QuickSort with 3-way partitioning

EDIT: To show you why I use ShellSort in SCAR, you could take a look at this page, which demonstrates most of the algorithms in this thread. HeapSort is sometimes slightly faster than ShellSort, but overall ShellSort is very fast no matter the input data, where for example HeapSort is a lot slower when the data is nearly sorted.

Edited by Freddy
##### Share on other sites

EDIT: Freddy fixed those 2 algorithms, much appreciated man!

Here you go, time for some good ol' Gravediggin'...

Bumping this awesome topic up because, I found out that HeapSort and QuickSort aren't working always correctly (most of the time).

Also, I wrote couple custom sorting algorithms, called as JnlbSort() and JnlbSort2W(). They are sooo freaking SLOW, though.

It was a funny little challenge for me anyways, because I just wanted to come up with a new way for sorting arrays - way that hasn't been released or possibly even discovered, by anyone else (as far as I know)!

Here is my testing script, by running it we can also easily/clearly see the issues with those 2 algorithms that are not working correctly:

```type
TSortAlgorithm = (sa_BubbleSort, sa_HeapSort, sa_InsertionSort,
sa_MergeSort, sa_MergeSortBU, sa_SelectionSort,
sa_ShellSort, sa_QuickSort, sa_QuickSort3W,
sa_JnlbSort, sa_JnlbSort2W);

procedure JnlbSort(var TIA: TIntArray; order: (so_LowToHigh, so_HighToLow));
var
a, x, i, l, lo: Integer;
begin
l := Length(TIA);
if (l > 1) then
begin
case order of
so_LowToHigh:
for i := 0 to (l - 2) do
begin
lo := i;
a := lo;
for x := (i + 1) to (l - 1) do
if (TIA[x] < TIA[lo]) then
lo := x;
if (lo > a) then
Swap(TIA[a], TIA[lo]);
end;
so_HighToLow:
for i := 0 to (l - 1) do
begin
lo := i;
a := lo;
for x := (i + 1) to l do
if (TIA[x] < TIA[lo]) then
lo := x;
if (lo > a) then
Swap(TIA[a], TIA[lo]);
end;
end;
end;
end;

procedure JnlbSort2W(var TIA: TIntArray; order: (so_LowToHigh, so_HighToLow));
var
a, b, x, i, l, hi, lo, s: Integer;
begin
l := Length(TIA);
if (l > 1) then
begin
s := ((l - 1) div 2);
case order of
so_LowToHigh:
for i := 0 to s do
begin
lo := i;
hi := ((l - 1) - i);
a := lo;
b := hi;
if (TIA[hi] < TIA[lo]) then
Swap(TIA[hi], TIA[lo]);
for x := (a + 1) to (b - 1) do
if (TIA[x] < TIA[lo]) then
lo := x
else
if (TIA[x] > TIA[hi]) then
hi := x;
if (lo > a) then
Swap(TIA[a], TIA[lo]);
if (hi < b) then
Swap(TIA[b], TIA[hi]);
end;
so_HighToLow:
for i := 0 to s do
begin
lo := i;
hi := ((l - 1) - i);
a := lo;
b := hi;
if (TIA[hi] > TIA[lo]) then
Swap(TIA[hi], TIA[lo]);
for x := (a + 1) to (b - 1) do
if (TIA[x] > TIA[lo]) then
lo := x
else
if (TIA[x] < TIA[hi]) then
hi := x;
if (lo < a) then
Swap(TIA[a], TIA[lo]);
if (hi > b) then
Swap(TIA[b], TIA[hi]);
end;
end;
end;
end;

function TIAByRange2bit(aStart, aFinish: Integer): TIntArray;
{==============================================================================]
Explanation: Returns a TIA that contains all the value from start value (aStart)
to finishing value (aFinish)..
Works with 2-bit method, that cuts loop in half.
[==============================================================================}
var
g, l, i, s, f: Integer;
begin
if (aStart <> aFinish) then
begin
s := Integer(aStart);
f := Integer(aFinish);
l := (IAbs(aStart - aFinish) + 1);
SetLength(Result, l);
g := ((l - 1) div 2);
case (aStart < aFinish) of
True:
begin
for i := 0 to g do
begin
Result[i] := (s + i);
Result[((l - 1) - i)] := (f - i);
end;
if ((l mod 2) <> 0) then
Result[i] := (s + i);
end;
False:
begin
for i := 0 to g do
begin
Result[i] := (s - i);
Result[((l - 1) - i)] := (f + i);
end;
if ((l mod 2) <> 0) then
Result[i] := (s - i);
end;
end;
end else
Result := [integer(aStart)];
end;

var
original: TIntArray;

procedure ShellSort(var Arr: TIntArray);
var
X, CurIndex, TmpIndex, Len: Integer;
begin
Len := Length(Arr);
X := 0;
while X < Len div 3 do
X := X * 3 + 1;
while X >= 1 do
begin
for CurIndex := X to Len - 1 do
begin
TmpIndex := CurIndex;
while (TmpIndex >= X) and (Arr[TmpIndex] < Arr[TmpIndex - X]) do
begin
Swap(Arr[TmpIndex], Arr[TmpIndex - X]);
DecEx(TmpIndex, X);
end;
end;
X := X div 3;
end;
end;

procedure BubbleSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi: Integer;
begin
Hi := High(Arr);
for CurIndex := 0 to Hi do
for TmpIndex := 1 to Hi - CurIndex do
if Arr[TmpIndex - 1] > Arr[TmpIndex] then
Swap(Arr[TmpIndex - 1], Arr[TmpIndex]);
end;

procedure SelectionSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi, Min: Integer;
begin
Hi := High(Arr);
for CurIndex := 0 to Hi do
begin
Min := CurIndex;
for TmpIndex := CurIndex + 1 to Hi do
if Arr[Min] > Arr[TmpIndex] then
Min := TmpIndex;
Swap(Arr[Min], Arr[CurIndex]);
end;
end;

procedure InsertionSort(var Arr: TIntArray);
var
CurIndex, TmpIndex, Hi, Min: Integer;
begin
Hi := High(Arr);
for CurIndex := 1 to Hi do
for TmpIndex := CurIndex downto 1 do
begin
if not (Arr[TmpIndex] < Arr[TmpIndex - 1]) then
Break;
Swap(Arr[TmpIndex - 1], Arr[TmpIndex]);
end;
end;

procedure Merge(var Arr, Aux: TIntArray; const Lo, Mid, Hi: Integer);
var
LHalf, RHalf, Index: Integer;
begin
LHalf := Lo;
RHalf := Mid + 1;

for Index := Lo to Hi do
Aux[index] := Arr[index];

for Index := Lo to Hi do
if LHalf > Mid then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else if RHalf > Hi then
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end else if Aux[RHalf] < Aux[LHalf] then
begin
Arr[index] := Aux[RHalf];
Inc(RHalf);
end else
begin
Arr[index] := Aux[LHalf];
Inc(LHalf);
end;
end;

procedure Sort(var Arr, Aux: TIntArray; const Lo, Hi: Integer);
var
Mid: Integer;
begin
if Lo >= Hi then Exit;

Mid := Lo + (Hi - Lo) div 2;

Sort(Arr, Aux, Lo, Mid);
Sort(Arr, Aux, Mid + 1, Hi);
Merge(Arr, Aux, Lo, Mid, Hi);
end;

procedure MergeSort(var Arr: TIntArray);
var
Len: Integer;
Aux: TIntArray;
begin
Len := Length(Arr);
if Len <= 1 then Exit;
SetLength(Aux, Len);
Sort(Arr, Aux, 0, Len - 1);
end;

procedure MergeSortBU(var Arr: TIntArray);
var
Len, Size, Lo: Integer;
Aux: TIntArray;
begin
Len := Length(Arr);
if Len <= 1 then Exit;
SetLength(Aux, Len);

Size := 1;
while Size < Len do
begin
Lo := 0;
while Lo < Len - Size do
begin
Merge(Arr, Aux, Lo, Lo + Size - 1, Min(Lo + Size * 2 - 1, Len - 1));
IncEx(Lo, Size * 2);
end;
IncEx(Size, Size);
end;
end;

procedure HeapSort(var Arr: TIntArray);
var
Len, Index, Pos, Tmp: Integer;
begin
Len := Length(Arr);
for Index := Len div 2 downto 1 do
begin
Pos := Index;
while Pos * 2 <= Len do
begin
Tmp := Pos * 2;
if (Tmp < Len) and (Arr[Tmp - 1] < Arr[Tmp]) then Inc(Tmp);
if not (Arr[Pos - 1] < Arr[Tmp - 1]) then Break;
Swap(Arr[Pos - 1], Arr[Tmp - 1]);
Pos := Tmp;
end;
end;
while Len > 0 do
begin
Swap(Arr[0], Arr[Len - 1]);
Pos := 1;
while Pos * 2 <= Len do
begin
Tmp := Pos * 2;
if (Tmp < Len) and (Arr[Tmp - 1] < Arr[Tmp]) then Inc(Tmp);
if not (Arr[Pos - 1] < Arr[Tmp - 1]) then Break;
Swap(Arr[Pos - 1], Arr[Tmp - 1]);
Pos := Tmp;
end;
Dec(Len);
end;
end;

procedure QSort3W(var Arr: TIntArray; const Lo, Hi: Integer);
var
LSide, RSide, Pos, Val: Integer;
begin
if Lo >= Hi then Exit;
Val := Arr[Lo];
LSide := Lo;
RSide := Hi;
Pos := Lo + 1;

while Pos <= RSide do
if Arr[Pos] < Val then
begin
Swap(Arr[LSide], Arr[Pos]);
Inc(Pos);
Inc(LSide);
end else if Arr[Pos] > Val then
begin
Swap(Arr[RSide], Arr[Pos]);
Dec(RSide);
end else
Inc(Pos);

QSort3W(Arr, Lo, LSide - 1);
QSort3W(Arr, RSide + 1, Hi);
end;

procedure QuickSort3W(var Arr: TIntArray);
begin
QSort3W(Arr, 0, Length(Arr) - 1);
end;

function Partition(var Arr: TIntArray; const Lo, Hi: Integer): Integer;
var
LSide, RSide, Val: Integer;
begin
Val := Arr[Lo];
LSide := Lo;
RSide := Hi + 1;

while True do
begin
repeat
Inc(LSide);
if (Val <= Arr[LSide]) or (LSide = Hi) then Break;
until False;
repeat
Dec(RSide);
if (Val >= Arr[RSide]) or (RSide = Lo) then Break;
until False;
if LSide >= RSide then Break;
Swap(Arr[LSide], Arr[RSide]);
end;

Swap(Arr[RSide], Arr[Lo]);
Result := LSide;
end;

procedure QSort(var Arr: TIntArray; const Lo, Hi: Integer);
var
Mid: Integer;
begin
if Lo >= Hi then Exit;
Mid := Partition(Arr, Lo, Hi);
QSort(Arr, Lo, Mid - 1);
QSort(Arr, Mid + 1, Hi);
end;

procedure QuickSort(var Arr: TIntArray);
begin
QSort(Arr, 0, Length(Arr) - 1);
end;

procedure TIARandomizeEx(var TIA: TIntArray; shuffles: Integer);
{==============================================================================]
Explanation: Randomizes TIA.
Example: [1, 2, 3] => [2, 3, 1]
The higher count of shuffles is, the "stronger" randomization you'll get.
[==============================================================================}
var
l, i, t: Integer;
begin
l := Length(TIA);
if ((l > 1) and (shuffles > 0)) then
for t := 1 to shuffles do
for i := 0 to (l - 1) do
Swap(TIA[Random(l)], TIA[Random(l)]);
end;

procedure SortingTimer(TIA: TIntArray; algorithm: TSortAlgorithm);
var
t: Integer;
s: string;
arr: TIntArray;
begin
arr := CopyTIA(TIA);
t := GetSystemTime;
case algorithm of
sa_BubbleSort:
begin
BubbleSort(arr);
s := 'BubbleSort()';
end;
sa_HeapSort:
begin
HeapSort(arr);
s := 'HeapSort()';
end;
sa_InsertionSort:
begin
InsertionSort(arr);
s := 'InsertionSort()';
end;
sa_MergeSort:
begin
MergeSort(arr);
s := 'MergeSort()';
end;
sa_MergeSortBU:
begin
MergeSortBU(arr);
s := 'MergeSortBU()';
end;
sa_SelectionSort:
begin
SelectionSort(arr);
s := 'SelectionSort()';
end;
sa_ShellSort:
begin
ShellSort(arr);
s := 'ShellSort()';
end;
sa_QuickSort:
begin
QuickSort(arr);
s := 'QuickSort()';
end;
sa_QuickSort3W:
begin
QuickSort3W(arr);
s := 'QuickSort3W()';
end;
sa_JnlbSort:
begin
JnlbSort(arr, so_LowToHigh);
s := 'JnlbSort()';
end;
sa_JnlbSort2W:
begin
JnlbSort2W(arr, so_LowToHigh);
s := 'JnlbSort2W()';
end;
end;
t := (GetSystemTime - t);
WriteLn(MD5(TIAToStr(arr)) + ': ' + IntToStr(t) + ' ms. [' + s + ']');
SetLength(arr, 0);
end;

begin
ClearDebug;
original := TIAByRange2bit(500, -500);
WriteLn(MD5(TIAToStr(original)) + ' (REVERSED):');

SortingTimer(original, sa_JnlbSort);
SortingTimer(original, sa_JnlbSort2W);
SortingTimer(original, sa_BubbleSort);
SortingTimer(original, sa_ShellSort);
SortingTimer(original, sa_SelectionSort);
SortingTimer(original, sa_InsertionSort);
SortingTimer(original, sa_MergeSort);
SortingTimer(original, sa_MergeSortBU);
SortingTimer(original, sa_HeapSort);
SortingTimer(original, sa_QuickSort);
SortingTimer(original, sa_QuickSort3W);

WriteLn('');
ReverseTIA(original);

SortingTimer(original, sa_JnlbSort);
SortingTimer(original, sa_JnlbSort2W);
SortingTimer(original, sa_BubbleSort);
SortingTimer(original, sa_ShellSort);
SortingTimer(original, sa_SelectionSort);
SortingTimer(original, sa_InsertionSort);
SortingTimer(original, sa_MergeSort);
SortingTimer(original, sa_MergeSortBU);
SortingTimer(original, sa_HeapSort);
SortingTimer(original, sa_QuickSort);
SortingTimer(original, sa_QuickSort3W);

WriteLn('');
TIARandomizeEx(original, 2);
WriteLn(MD5(TIAToStr(original)) + ' (RANDOMIZED):');

SortingTimer(original, sa_JnlbSort);
SortingTimer(original, sa_JnlbSort2W);
SortingTimer(original, sa_BubbleSort);
SortingTimer(original, sa_ShellSort);
SortingTimer(original, sa_SelectionSort);
SortingTimer(original, sa_InsertionSort);
SortingTimer(original, sa_MergeSort);
SortingTimer(original, sa_MergeSortBU);
SortingTimer(original, sa_HeapSort);
SortingTimer(original, sa_QuickSort);
SortingTimer(original, sa_QuickSort3W);

WriteLn('');
FillTIAEx(original, [1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384]);
WriteLn(MD5(TIAToStr(original)) + ' ("FEW" UNIQUE):');

SortingTimer(original, sa_JnlbSort);
SortingTimer(original, sa_JnlbSort2W);
SortingTimer(original, sa_BubbleSort);
SortingTimer(original, sa_ShellSort);
SortingTimer(original, sa_SelectionSort);
SortingTimer(original, sa_InsertionSort);
SortingTimer(original, sa_MergeSort);
SortingTimer(original, sa_MergeSortBU);
SortingTimer(original, sa_HeapSort);
SortingTimer(original, sa_QuickSort);
SortingTimer(original, sa_QuickSort3W);

end.```

Working HeapSort():

```procedure HeapSort(var TIA: TIntArray);
var
a, b, r, c, l: Integer;
begin
l := Length(TIA);
a := ((l - 1) div 2);
while (a >= 0) do
begin
r := a;
while (((r * 2) + 1) <= (l - 1)) do
begin
c := ((r * 2) + 1);
if ((c < (l - 1)) and (TIA[c] < TIA[(c + 1)])) then
c := (c + 1);
if (TIA[r] < TIA[c]) then
begin
Swap(TIA[r], TIA[c]);
r := c;
end else
Break;
end;
a := (a - 1);
end;
b := (l - 1);
while (b > 0) do
begin
Swap(TIA[b], TIA[0]);
b := (b - 1);
r := 0;
while (((r * 2) + 1) <= b) do
begin
c := ((r * 2) + 1);
if ((c < b) and (TIA[c] < TIA[(c + 1)])) then
c := (c + 1);
if (TIA[r] < TIA[c]) then
begin
Swap(TIA[r], TIA[c]);
r := c;
end else
Break;
end;
end;
end;

var
TIA: TIntArray;

begin
TIA := [1, 3, 1, 2, 4, 0, -1, 9, 8, 5, 5, 6, 7];
WriteLn(TIAToStr(TIA));
HeapSort(TIA);
WriteLn(TIAToStr(TIA));
end.```

Script is also attached below.

-Jani

Sorting_Algorithms.scar

Edited by Janilabo
##### Share on other sites

Created an include ("sortingLib") with all sorting algorithms Freddy introduced here + 4 of my custom ones, JnlbSort, JnlbSort2W, JnlbSortDnmc and JnlbSortDnmc2W.

Contains sorting algorithms for TIntArray's, TStrArray's, TExtArray's and TCharArray's.

Sorting both ways is supported, High to Low and Low to High - this is based on TSortOrder type.

Credits to:

-Algorithm creators/innovators

-Freddy

Include is attached!

NOTE: I added "__" before any commands that are needed only for particular algorithms to get em working correctly (QuickSort, QuickSort3W, MergeSort and MergeSortBU are based on those commands).

sortingLib.scar

## Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

×   Pasted as rich text.   Paste as plain text instead

Only 75 emoji are allowed.

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×

×