Sorting Algorithms

For this post, we will examine the following sorting algorithms. The algorithms shown are the following.

  1. Insertion Sort
  2. Shell Sort
  3. Selection Sort
  4. Quick Sort

Below are the animations showing how the sorting works. 

As we can see, the fastest of all is the Quicksort


Code 

The algorithms for all the above are given below. Feel free to download and run them. 

SomeListQ[list_List] := Or @@ (ListQ /@ list);


pivotedList[list_List] :=
Module[{pivotPosition, pivotValue, pivotList, prePivotList, postPivotList, skippedRange, length = Length@list, pivotedList},
pivotPosition = RandomChoice[Range[1, length]];
pivotValue = list[[pivotPosition]];
pivotList = {pivotValue};
prePivotList = {};
postPivotList = {};
skippedRange = Delete[Range[length], pivotPosition];

Table[Piecewise[
{
{AppendTo[pivotList, list[[r]]], list[[r]] == pivotValue},
{AppendTo[prePivotList, list[[r]]], list[[r]] < pivotValue},
{AppendTo[postPivotList, list[[r]]], list[[r]] > pivotValue}
}], {r, skippedRange}];
pivotedList = Join @@ {{postPivotList}, pivotList, {prePivotList}};
pivotedList
];


QuickSortTrack[listIn_List] := Module[{list = {listIn}, pivotOut, tracker = {}},
While[SomeListQ[list],
Table[
If[ListQ[list[[q]]],
pivotOut = DeleteCases[pivotedList[list[[q]]], {}];
list = Drop[list, {q}];
Table[list = Insert[list, pivotOut[[s]], q], {s, 1, Length@pivotOut}]];, {q, 1, Length@list}];
AppendTo[tracker, Flatten@list];];
Return@tracker
];

QuickSortTrackRaw[listIn_List] := Module[{list = {listIn}, pivotOut, tracker = {}},
While[SomeListQ[list],
Table[
If[ListQ[list[[q]]],
pivotOut = DeleteCases[pivotedList[list[[q]]], {}];
list = Drop[list, {q}];
Table[list = Insert[list, pivotOut[[s]], q], {s, 1, Length@pivotOut}]];, {q, 1, Length@list}];
AppendTo[tracker, list];];
Return@tracker
];

QuickSort[listIn_List] := Module[{list = {listIn}, pivotOut},
While[SomeListQ[list],
Table[
If[ListQ[list[[q]]],
pivotOut = DeleteCases[pivotedList[list[[q]]], {}];
list = Drop[list, {q}];
Table[list = Insert[list, pivotOut[[s]], q], {s, 1, Length@pivotOut}]];, {q, 1, Length@list}];
];
Return@list
];


InsertionSortTrack[list_List] := Module[{listOut = list, temp, i, j, length, track = List[]},
length = Length@list;
For[i = 2, i <= length, i++,
For[j = i, j > 1 && listOut[[j]] < listOut[[j - 1]], j--,
temp = listOut[[j]];
listOut[[j]] = listOut[[j - 1]];
listOut[[j - 1]] = temp;
];
AppendTo[track, listOut];
];
track
];

InsertionSort[list_List] := Module[{listOut = list, temp, i, j, length},
length = Length@list;
For[i = 2, i <= length, i++,
For[j = i, j > 1 && listOut[[j]] < listOut[[j - 1]], j--,
temp = listOut[[j]];
listOut[[j]] = listOut[[j - 1]];
listOut[[j - 1]] = temp;
]
];
listOut
];


ShellSortTrack[list_List] := Module[{temp, i, j, h = 1, length, listOut, track = List[]},
listOut = list;
length = Length@list;
While[h < length / 3, h = 3 * h + 1];
While[h >= 1,
For[i = h, i < length + 1, i++,
For[j = i, j >= h && (listOut[[j]] < listOut[[j - h]]), j -= h,
temp = listOut[[j - h]];
listOut[[j - h]] = listOut[[j]];
listOut[[j]] = temp;
];
AppendTo[track, listOut];
];
h = Floor[h / 3];
];
track
];

ShellSort[list_List] := Module[{temp, i, j, h = 1, length, listOut},
listOut = list;
length = Length@list;
While[h < length / 3, h = 3 * h + 1];
While[h >= 1,
For[i = h, i < length + 1, i++,
For[j = i, j >= h && (listOut[[j]] < listOut[[j - h]]), j -= h,
temp = listOut[[j - h]];
listOut[[j - h]] = listOut[[j]];
listOut[[j]] = temp;
];
];
h = Floor[h / 3];
];
listOut
];


SelectionSortTrack[list_List] := Module[{listOut = list, min, length, temp, track = List[]},
length = Length@list;
For[i = 1, i <= length, i++,
min = i;
For[j = i + 1, j <= length, j++,
If[listOut[[j]] < listOut[[min]], min = j]];
temp = listOut[[i]];
listOut[[i]] = listOut[[min]];
listOut[[min]] = temp;
AppendTo[track, listOut];
];
track
];


SelectionSort[list_List] := Module[{listOut = list, min, length, temp},
length = Length@list;
For[i = 1, i <= length, i++,
min = i;
For[j = i + 1, j <= length, j++,
If[listOut[[j]] < listOut[[min]], min = j]];
temp = listOut[[i]];
listOut[[i]] = listOut[[min]];
listOut[[min]] = temp;
];
listOut
];

FactorialRecursive[n_] :=
Module[{result},
If[n == 1 || n == 0, result = 1, result = FactorialRecursive = n * FactorialRecursive[n - 1]];
result];


ExportSelectionAlgorithm[sortingFunction_Symbol, label_String] :=
Module[{images, randomData = Join @@ Import[NotebookDirectory[] <> "sorting_data.csv"], durations},
images = Labeled[
BarChart[#,
PlotRange -> {Automatic, {0, 1}},
FrameTicks -> None,
AspectRatio -> 1,
Frame -> True,
ImageSize -> 300], label, Top] & /@ sortingFunction[randomData];
durations = ConstantArray[0.2, Length@images];
durations[[-1]] = 6;
Export[NotebookDirectory[] <> label <> "_example.gif",
images,
"DisplayDurations" -> durations,
"AnimationRepetitions" -> \[Infinity]]
];

ExportSelectionAlgorithmExecute := Module[{functions},
functions =
Association@{"Selection_Sort" -> SelectionSortTrack,
"Insertion_Sort" -> InsertionSortTrack,
"Shell_Sort" -> ShellSortTrack, "Quick_Sort" -> QuickSortTrack
};
MapThread[
ExportSelectionAlgorithm[#1, #2] &, {Values@functions,
Keys@functions}]
]

End of the post