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
      List.Add(pointer(i));
      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
      List.Add(pointer(Sentinel));
    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
        List.Add(pointer(i*10))
      else
        List.Add(pointer(EqualValue));
      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');
  readln;
end.