Tests for the sorts from my book

published: Thu, 13-May-2004   |   updated: Thu, 27-Oct-2005

Recently, someone reported a bug in the QuickSort routine from my book. In investigating the problem, I wrote a test program that tested every sort routine from the book to sort items from sets that were shuffled, reverse sorted, and already sorted. (Quicksort can be notorious for already sorted sets.) The tests run the sorts on sets that had from 1 to 500 items (I'd also received a bug report, erroneous this time, that the Quicksort didn't work for a small number of items). Any more than 500, I'd get really bored waiting for bubble sort to finish.

Since the sorts were written to also sort subsets of the items, I've included tests for sorting subsets that were shuffled, reverse sorted, and already sorted.

To make ultra sure, I also included tests that sorted items that were mostly equal in sets that were shuffled, reverse sorted, and already sorted.

With the fix described here, this program shows comprehensively that all sorts in the book work, and work well.

```program ComprehensiveSortTest;

{\$apptype console}

uses
SysUtils,
Classes,
TDBasics,
TDTList,
TDSorts;

const
SetSize = 500;

type
TSortAlgorithm = procedure (aList    : TList;
aFirst   : integer;
aLast    : integer;
aCompare : TtdCompareFunc);

type
TSortRoutine = class
Name : string;
Sort : TSortAlgorithm;
constructor Create(aName : string; aSort : TSortAlgorithm);
end;

type
TTestSortProcedure = procedure (aSort : TSortRoutine);

var
Sorts : array [0..14] of TSortRoutine;

constructor TSortRoutine.Create(aName : string; aSort : TSortAlgorithm);
begin
Name := aName;
Sort := aSort;
end;

const
Sentinel : integer = \$77665544;
EqualValue : integer = 99;

function CheckSorted(aList : TList; aFirst, aLast : integer) : boolean;
var
i : integer;
begin
Result := false;
for i := 0 to pred(aFirst) do
if (longint(aList[i]) <> Sentinel) then
Exit;
for i := succ(aLast) to pred(aList.Count) do
if (longint(aList[i]) <> Sentinel) then
Exit;
for i := aFirst + 1 to aLast do
if (longint(aList[i-1]) > longint(aList[i])) then
Exit;
Result := true;
end;

procedure TestSorting(aSort : TSortAlgorithm;
aList : TList;
aFirst, aLast : integer);
begin
// sort shuffled list
TDListShuffle(aList, aFirst, aLast);
aSort(aList, aFirst, aLast, TDCompareLongint);
if not CheckSorted(aList, aFirst, aLast) then begin
writeln('Error in sorted list');
Halt;
end;
// sort reversed list
TDListReverse(aList, aFirst, aLast);
aSort(aList, aFirst, aLast, TDCompareLongint);
if not CheckSorted(aList, aFirst, aLast) then begin
writeln('Error in sorted list');
Halt;
end;
// sort sorted list
aSort(aList, aFirst, aLast, TDCompareLongint);
if not CheckSorted(aList, aFirst, aLast) then begin
writeln('Error in sorted list');
Halt;
end;
end;

procedure MainTests(aSort : TSortRoutine);
var
List : TList;
i : integer;
begin
writeln(aSort.Name + ': testing with full sets of items');
List := TList.Create;
try
for i := 1 to SetSize do begin
TestSorting(aSort.Sort, List, 0, pred(List.Count));
end;
finally
List.Free;
end;
end;

procedure SubsetTests(aSort : TSortRoutine);
var
List : TList;
i, j : integer;
begin
writeln(aSort.Name + ': testing with subsets');
List := TList.Create;
try
for i := 1 to SetSize do
i := 10;
for j := 10 to SetSize - 10 do begin
List[j] := pointer(j);
TestSorting(aSort.Sort, List, i, j);
end;
finally
List.Free;
end;
end;

procedure MostlyEqualTests(aSort : TSortRoutine);
var
List : TList;
i : integer;
begin
writeln(aSort.Name + ': testing with mostly-equal items');
List := TList.Create;
try
for i := 1 to SetSize do begin
if (i <= 20) then
else
TestSorting(aSort.Sort, List, 0, pred(List.Count));
end;
finally
List.Free;
end;
end;

procedure RunTestSeries(aRunTest : TTestSortProcedure);
var
i : integer;
begin
for i := 0 to 14 do
aRunTest(Sorts[i]);
end;

var
i : integer;
begin
try
try
Sorts[0] := TSortRoutine.Create('Bubble sort', TDBubbleSort);
Sorts[1] := TSortRoutine.Create('Shaker sort', TDShakerSort);
Sorts[2] := TSortRoutine.Create('Comb sort', TDCombSort);
Sorts[3] := TSortRoutine.Create('Selection sort', TDSelectionSort);
Sorts[4] := TSortRoutine.Create('Insertion sort (standard)', TDInsertionSortStd);
Sorts[5] := TSortRoutine.Create('Insertion sort', TDInsertionSort);
Sorts[6] := TSortRoutine.Create('Shellsort', TDShellSort);
Sorts[7] := TSortRoutine.Create('Merge sort (standard)', TDMergeSortStd);
Sorts[8] := TSortRoutine.Create('Merge sort', TDMergeSort);
Sorts[9] := TSortRoutine.Create('Quicksort (standard)', TDQuickSortStd);
Sorts[10]:= TSortRoutine.Create('Quicksort (no recursion)', TDQuickSortNoRecurse);
Sorts[11]:= TSortRoutine.Create('Quicksort (random pivot)', TDQuickSortRandom);
Sorts[12]:= TSortRoutine.Create('Quicksort (median of 3 pivot)', TDQuickSortMedian);
Sorts[13]:= TSortRoutine.Create('Quicksort', TDQuickSort);
Sorts[14]:= TSortRoutine.Create('Heapsort', TDHeapSort);

RunTestSeries(MainTests);
RunTestSeries(SubsetTests);
RunTestSeries(MostlyEqualTests);
finally
for i := 0 to 14 do
Sorts[i].Free;
end;
except
on E : Exception do
writeln(E.Message);
end;
writeln('Done');