unit SortF;
//*******************************************************
// Example program demonstrating sorting algorithms.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls;

const
    NUM_ALGS = 9;
    INFINITY = 2147483647;

type
  TLongintArray = array [1..10000000] of Longint;
  PLongintArray = ^TLongintArray;

  // This is not PLongintArray because the value bounds
  // might not start at 1 for all programs.
  TCountArray = array [1..10000000] of Longint;
  PCountArray = ^TCountArray;

  // Linked list cells.
  PCell = ^TCell;
  TCell = record
      Value    : Longint; // The data.
      NextCell : PCell;   // The next cell.
  end;
  TCellArray = array [1..1000000] of TCell;
  PCellArray = ^TCellArray;

  TAlgorithm = procedure (list : PLongintArray; min, max : Longint) of object;

  TSortForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    NumItemsText: TEdit;
    MaxValueText: TEdit;
    Label2: TLabel;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    optAlgBubblesort: TRadioButton;
    optAlgSelectionsort: TRadioButton;
    optAlgInsertionsort: TRadioButton;
    optAlgLLInsertionsort: TRadioButton;
    optAlgHeapsort: TRadioButton;
    optAlgMergesort: TRadioButton;
    optAlgQuicksort: TRadioButton;
    Label8: TLabel;
    optAlgLLBucketsort: TRadioButton;
    optAlgCountingsort: TRadioButton;
    Label9: TLabel;
    optOrderRandom: TRadioButton;
    optOrderSorted: TRadioButton;
    optOrderReversed: TRadioButton;
    NumUnsortedText: TEdit;
    Label5: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    ScrollBox1: TScrollBox;
    ScrollBox2: TScrollBox;
    UnsortedLabel: TLabel;
    SortedLabel: TLabel;
    CmdMakelist: TButton;
    Label10: TLabel;
    TimeLabel: TLabel;
    CmdGo: TButton;
    NumRepetitionsText: TEdit;
    CutoffText: TEdit;
    Label4: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure DisableGo(Sender: TObject);
    procedure CmdMakelistClick(Sender: TObject);
    function SelectedAlgorithm : Integer;
    procedure CmdGoClick(Sender: TObject);
    procedure ShowUnsorted;
    procedure ShowResults;
    procedure DoArraySort(alg : TAlgorithm);
    procedure DoInsertionsort;
    procedure Insertionsort(list : PLongintArray; min, max : Longint);
    function BuildLinkedList : PCell;
    procedure CopyLinkedList(top : PCell);
    procedure DeleteLinkedList(var top : PCell);
    procedure DoLLInsertionsort;
    procedure LLInsertionsort(var top : PCell);
    procedure DoSelectionsort;
    procedure Selectionsort(list : PLongintArray; min, max : Longint);
    procedure DoBubblesort;
    procedure Bubblesort(list : PLongintArray; min, max : Longint);
    procedure DoQuicksort;
    procedure Quicksort(list : PLongintArray; min, max : Longint);
    procedure DoMergesort;
    procedure Mergesort(list, scratch : PLongintArray; min, max : Longint);
    procedure DoHeapsort;
    procedure Heapsort(list : PLongintArray; min, max : Longint);
    procedure DoCountingsort;
    procedure Countingsort(list : PLongintArray; counts : PCountArray; min, max, min_value, max_value : Longint);
    procedure DoLLBucketsort;
    procedure LLBucketsort(top : PCell);
    procedure CheckResults;
  private
    { Private declarations }
    AlgButton    : array [1..NUM_ALGS] of TRadioButton;
    Algs         : array [1..NUM_ALGS] of procedure of object;
    NumItems     : Longint;
    MaxValue     : Longint;
    NumReps      : Longint;
    Cutoff       : Longint;
    EllapsedTime : TDateTime;
    UnsortedList : PLongintArray;
    SortedList   : PLongintArray;

  public
    { Public declarations }
  end;

var
  SortForm: TSortForm;

implementation

{$R *.DFM}

// Save the algorithm option buttons into an array;
procedure TSortForm.FormCreate(Sender: TObject);
begin
    Randomize;

    AlgButton[1] := optAlgSelectionsort;
    AlgButton[2] := optAlgInsertionsort;
    AlgButton[3] := optAlgLLInsertionsort;
    AlgButton[4] := optAlgBubblesort;
    AlgButton[5] := optAlgQuicksort;
    AlgButton[6] := optAlgMergesort;
    AlgButton[7] := optAlgHeapsort;
    AlgButton[8] := optAlgCountingsort;
    AlgButton[9] := optAlgLLBucketsort;

    Algs[1] := DoSelectionsort;
    Algs[2] := DoInsertionsort;
    Algs[3] := DoLLInsertionsort;
    Algs[4] := DoBubblesort;
    Algs[5] := DoQuicksort;
    Algs[6] := DoMergesort;
    Algs[7] := DoHeapsort;
    Algs[8] := DoCountingsort;
    Algs[9] := DoLLBucketsort;
end;

procedure TSortForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure TSortForm.mnuAboutClick(Sender: TObject);
const
    CR = #13#10;
    CRCR = #13#10#13#10;
begin
    MessageDlg(
            'This program demonstrates several different sorting algorithms.' + CRCR +
            'Enter list characteristics and click the Make List button to create the random items. Use small lists until you know how long your computer will take.' + CRCR +
            'Then select an algorithm and click the Go button.'
        , mtInformation, [mbOK], 0);
end;

// Disable the Go button until the user makes the list.
procedure TSortForm.DisableGo(Sender: TObject);
begin
    CmdGo.Enabled := False;
end;

// Build a list of items to sort.
procedure TSortForm.CmdMakelistClick(Sender: TObject);
var
    i, j, tmp : Longint;
begin
    // Allocate list memory.
    if (NumItems > 0) then
    begin
        FreeMem(UnsortedList);
        FreeMem(SortedList);
    end;
    NumItems := StrToInt(NumItemsText.Text);
    GetMem(UnsortedList, NumItems * SizeOf(Longint));
    GetMem(SortedList, NumItems * SizeOf(Longint));
    MaxValue := StrToInt(MaxValueText.Text);

    // Create the items.
    for i := 1 to NumItems do
        UnsortedList^[i] := 1 + Trunc(Random(MaxValue));

    // Sort them if appropriate.
    if (not optOrderRandom.Checked) then
    begin
        // Sort the items.
        Quicksort(UnsortedList, 1, NumItems);

        if (optOrderReversed.Checked) then
        begin
            // Reverse the items.
            for i := 1 to NumItems div 2 do
            begin
                tmp := UnsortedList^[i];
                UnsortedList^[i] :=
                    UnsortedList^[NumItems - i + 1];
                UnsortedList^[NumItems - i + 1] := tmp;
            end;
        end;

        // Place some out of order if required.
        for i := 1 to StrToInt(NumUnsortedText.Text) do
        begin
            j := 1 + Trunc(Random(NumItems));
            UnsortedList^[j] := 1 + Trunc(Random(MaxValue));
        end;
    end;

    ShowUnsorted;

    CmdGo.Enabled := True;
end;

// Return the index of the selected algorithm.
function TSortForm.SelectedAlgorithm : Integer;
begin
    for Result := 1 to NUM_ALGS do
        if (AlgButton[Result].Checked) then exit;
    Result := 1;
end;

// Run the proper algorithm.
procedure TSortForm.CmdGoClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;
    NumReps := StrToInt(NumRepetitionsText.Text);
    Cutoff := StrToInt(CutoffText.Text);
    EllapsedTime := 0;

    Algs[SelectedAlgorithm];

    CheckResults;
    ShowResults;
    Screen.Cursor := crDefault;
end;

// Display the unsorted list.
procedure TSortForm.ShowUnsorted;
const
    CR = #13#10;
var
    i, num : Integer;
    txt    : String;
begin
    if (NumItems > 1000) then
        num := 1000
    else
        num := NumItems;
    txt := '';
    for i := 1 to num do
        txt := txt +
            Format('%12d', [UnsortedList^[i]]) + CR;
    if (NumItems > 1000) then txt := txt + '<etc.>';
    UnsortedLabel.Caption := txt;
end;

// Display the results.
procedure TSortForm.ShowResults;
const
    CR = #13#10;
var
    h, m, s, ms : Word;
    i, num      : Integer;
    txt         : String;
begin
    if (NumItems > 1000) then
        num := 1000
    else
        num := NumItems;
    txt := '';
    for i := 1 to num do
        txt := txt +
            Format('%12d', [SortedList^[i]]) + CR;
    if (NumItems > 1000) then txt := txt + '<etc.>';
    SortedLabel.Caption := txt;

    DecodeTime(EllapsedTime, h, m, s, ms);
    TimeLabel.Caption := Format('%.2f',
        [ms / 1000.0 + s + 60 * (m + h * 60)]);
end;

// Run an algorithm that uses arrays. Manage resetting of
// the SortedList and timing.
procedure TSortForm.DoArraySort(alg : TAlgorithm);
var
    start_time : TDateTime;
    rep, i     : Longint;
begin
    EllapsedTime := 0;
    for rep := 1 to NumReps do
    begin
        // Copy the unsorted list into the sorted array.
        for i := 1 to NumItems do
            SortedList^[i] := UnsortedList^[i];

        // Run the algorithm.
        start_time := Time;
        alg(SortedList, 1, NumItems);
        EllapsedTime := EllapsedTime + Time - start_time;
    end;
end;

procedure TSortForm.DoInsertionsort;
begin
    DoArraySort(Insertionsort);
end;
procedure TSortForm.Insertionsort(list : PLongintArray; min, max : Longint);
var
    i, j, k, max_sorted, next_num : Longint;
begin
    max_sorted := min - 1;
    for i := min to max do
    begin
        // This is the number we are inserting.
        next_num := list^[i];

        // See where it belongs in the list.
        for j := min to max_sorted do
            if (list^[j] >= next_num) then break;

        // Bump the bigger sorted numbers down to make
        // room for the new number.
        for k := max_sorted downto j do
            list^[k + 1] := list^[k];

        // Insert the new number.
        list^[j] := next_num;

        // Increment the count of the sorted items.
        max_sorted := max_sorted + 1;
    end;
end;

// Build a linked list containing the unsorted items.
function TSortForm.BuildLinkedList : PCell;
var
    cell : PCell;
    i    : Longint;
begin
    New(Result);
    Result^.NextCell := nil;
    cell := Result;
    for i := 1 to NumItems do
    begin
        New(cell^.NextCell);
        cell := cell^.NextCell;
        cell^.Value := UnsortedList^[i];
    end;
    cell^.NextCell := nil;
end;

// Copy a sorted linked list into the sorted list array.
procedure TSortForm.CopyLinkedList(top : PCell);
var
    cell : PCell;
    i    : Longint;
begin
    cell := top^.NextCell;
    for i := 1 to NumItems do
    begin
        SortedList^[i] := cell^.Value;
        cell := cell^.NextCell;
    end;
end;

// Delete a linked list.
procedure TSortForm.DeleteLinkedList(var top : PCell);
var
    cell : PCell;
begin
    while (top <> nil) do
    begin
        cell := top^.NextCell;
        Dispose(top);
        top := cell;
    end;
end;

procedure TSortForm.DoLLInsertionsort;
var
    start_time : TDateTime;
    rep        : Longint;
    top        : PCell;
begin
    EllapsedTime := 0;
    for rep := 1 to NumReps do
    begin
        // Build a linked list containing the unsorted items.
        top := BuildLinkedList;

        // Run the algorithm.
        start_time := Time;
        LLInsertionsort(top);
        EllapsedTime := EllapsedTime + Time - start_time;

        // Copy the result into the sorted array.
        if (rep = NumReps) then CopyLinkedList(top);

        // Delete the sorted list.
        DeleteLinkedList(top);
    end;
end;
procedure TSortForm.LLInsertionsort(var top : PCell);
var
    new_top, cell, after_me, nxt : PCell;
    new_value                    : Longint;
begin
    // Make the new list with a bottom sentinel.
    New(new_top);
    New(new_top^.NextCell);
    new_top^.NextCell^.Value := INFINITY;
    new_top^.NextCell^.NextCell := nil;
    
    cell := top^.NextCell;
    while (cell <> nil) do
    begin
        top^.NextCell := cell^.NextCell;
        new_value := cell^.Value;

        // See where the new item belongs.
        after_me := new_top;
        nxt := after_me^.NextCell;
        while (nxt^.Value < new_value) do
        begin
            after_me := nxt;
            nxt := after_me^.NextCell;
        end;

        // Insert the cell into the new list.
        after_me^.NextCell := cell;
        cell^.NextCell := nxt;

        // Examine the next cell in the old list.
        cell := top^.NextCell;
    end;

    // Free the old list top.
    Dispose(top);
    top := new_top;
end;

procedure TSortForm.DoSelectionsort;
begin
    DoArraySort(Selectionsort);
end;
procedure TSortForm.Selectionsort(list : PLongintArray; min, max : Longint);
var
    i, j, best_value, best_j : Longint;
begin
    for i := min to max - 1 do
    begin
        // Find the smallest remaining item.
        best_value := list^[i];
        best_j := i;
        for j := i + 1 to max do
            if (list^[j] < best_value) then
            begin
                best_value := list^[j];
                best_j := j;
            end;

        // Swap it into position.
        list^[best_j] := list^[i];
        list^[i] := best_value;
    end;
end;

procedure TSortForm.DoBubblesort;
begin
    DoArraySort(Bubblesort);
end;
// Bubblesort with:
//   - Alternating upward and downward passes
//   - Holding bubbled item in a temporary variable
//   - Updating min and max to narrow the search range
procedure TSortForm.Bubblesort(list : PLongintArray; min, max : Longint);
var
    i, j, tmp, last_swap : Longint;
begin
    // Repeat until we are done.
    while (min < max) do
    begin
        // Bubble up.
        last_swap := min - 1;
        // For i := min + 1 To max
        i := min + 1;
        while (i <= max) do
        begin
            // Find a "bubble."
            if (list^[i - 1] > list^[i]) then
            begin
                // See where to drop the bubble.
                tmp := list^[i - 1];
                j := i;
                repeat
                    list^[j - 1] := list^[j];
                    j := j + 1;
                    if (j > max) then break;
                until (list^[j] >= tmp);
                list^[j - 1] := tmp;
                last_swap := j - 1;
                i := j + 1;
            end else
                i := i + 1;
        end; // End bubbling up.
        // Update max.
        max := last_swap - 1;

        // Bubble down.
        last_swap := max + 1;
        // For i := max - 1 To min Step -1
        i := max - 1;
        while (i >= min) do
        begin
            // Find a "bubble."
            if (list^[i + 1] < list^[i]) then
            begin
                // See where to drop the bubble.
                tmp := list^[i + 1];
                j := i;
                repeat
                    list^[j + 1] := list^[j];
                    j := j - 1;
                    if (j < min) then break;
                until (list^[j] <= tmp);
                list^[j + 1] := tmp;
                last_swap := j + 1;
                i := j - 1;
            end else
                i := i - 1;
        end; // End bubbling up.
        // Update min.
        min := last_swap + 1;
    end; // End downward and upward passes.
end;

procedure TSortForm.DoQuicksort;
begin
    DoArraySort(Quicksort);
end;
// Quicksort with:
//   - Uses Rnd to select a random dividing value
//   - Stops when there are fewer than CutOff items left
//       to sort. It then finishes using SelectionSort.
procedure TSortForm.Quicksort(list : PLongintArray; min, max : Longint);
var
    med_value, hi, lo, i : Longint;
begin
    // If the list has no more than CutOff elements,
    // finish it off with Selectionsort.
    if (max - min < CutOff) then
    begin
        Selectionsort(list, min, max);
        exit;
    end;

    // Pick the dividing value.
    i := min + Trunc(Random(max - min + 1));
    med_value := list^[i];

    // Swap it to the front.
    list^[i] := list^[min];

    lo := min;
    hi := max;
    repeat // Repeat infinitely.
        // Look down from hi for a value < med_value.
        while (list^[hi] >= med_value) do
        begin
            hi := hi - 1;
            if (hi <= lo) then break;
        end;
        if (hi <= lo) then
        begin
            list^[lo] := med_value;
            break;
        end;

        // Swap the lo and hi values.
        list^[lo] := list^[hi];

        // Look up from lo for a value >:= med_value.
        lo := lo + 1;
        while (list^[lo] < med_value) do
        begin
            lo := lo + 1;
            if (lo >= hi) then break;
        end;
        if (lo >= hi) then
        begin
            lo := hi;
            list^[hi] := med_value;
            break;
        end;

        // Swap the lo and hi values.
        list^[hi] := list^[lo];
    until (False);

    // Sort the two sublists.
    Quicksort(list, min, lo - 1);
    Quicksort(list, lo + 1, max);
end;

procedure TSortForm.DoMergesort;
var
    start_time : TDateTime;
    rep, i     : Longint;
    scratch    : PLongintArray;
begin
    // Allocate a scratch array.
    GetMem(scratch, NumItems * SizeOf(Longint));

    EllapsedTime := 0;
    for rep := 1 to NumReps do
    begin
        // Copy the unsorted list into the sorted array.
        for i := 1 to NumItems do
            SortedList^[i] := UnsortedList^[i];

        // Run the algorithm.
        start_time := Time;
        Mergesort(SortedList, scratch, 1, NumItems);
        EllapsedTime := EllapsedTime + Time - start_time;
    end;

    // Free memory allocated for the scratch array.
    FreeMem(scratch);
end;
// Mergesort with:
//   - Stops recursion when there are fewer than Cutoff
//       items in the list. Finishes with SelectionSort.
procedure TSortForm.Mergesort(list, scratch : PLongintArray; min, max : Longint);
var
    middle, i1, i2, i3 : Longint;
begin
    // If the list has no more than CutOff elements,
    // finish it off with Selectionsort.
    if (max - min < CutOff) then
    begin
        Selectionsort(list, min, max);
        exit;
    end;

    // Recursively sort the sublists.
    middle := max div 2 + min div 2;
    Mergesort(list, scratch, min, middle);
    Mergesort(list, scratch, middle + 1, max);

    // Merge the sorted lists.
    i1 := min;        // Index in list 1
    i2 := middle + 1; // Index in list 2
    i3 := min;        // Index in merged list
    while ((i1 <= middle) and (i2 <= max)) do
    begin
        if (list^[i1] <= list^[i2]) then
        begin
            scratch^[i3] := list^[i1];
            i1 := i1 + 1;
        end else begin
            scratch^[i3] := list^[i2];
            i2 := i2 + 1;
        end;
        i3 := i3 + 1;
    end;

    // Empty out whichever list is not already empty.
    while (i1 <= middle) do
    begin
        scratch^[i3] := list^[i1];
        i1 := i1 + 1;
        i3 := i3 + 1;
    end;
    while (i2 <= max) do
    begin
        scratch^[i3] := list^[i2];
        i2 := i2 + 1;
        i3 := i3 + 1;
    end;

    // Move the merged list back into list.
    for i3 := min to max do
        list^[i3] := scratch^[i3];
end;

procedure TSortForm.DoHeapsort;
begin
    DoArraySort(Heapsort);
end;
procedure TSortForm.Heapsort(list : PLongintArray; min, max : Longint);
var
    i, tmp : Longint;

    // Push the top item down through the heap until it
    // can go no farther.
    procedure HeapPushDown(list : PLongintArray; min, max : Longint);
    var
        tmp, j : Longint;
    begin
        tmp := list^[min];
        repeat // Repeat infinitely.
            j := 2 * min;
            if (j > max) then
                break // Done. Past end of heap.
            else begin
                // Make j the larger of the children.
                if (j < max) then
                    if (list^[j + 1] > list^[j]) then
                        j := j + 1;

                if (list^[j] > tmp) then
                begin
                    // A child is bigger. Swap with child.
                    list^[min] := list^[j];
                    // Push down beneath that child.
                    min := j;
                end else
                    // The parent is bigger. We're done.
                    break;
            end;
        until (False);
        list^[min] := tmp;
    end; // End procedure HeapPushDown.

begin
    // Make a heap (except for the root node).
    for i := (max + min) div 2 downto min + 1 do
        HeapPushDown(list, i, max);

    // Repeatedly:
    //   1. HeapPushDown.
    //   2. Output the root.
    for i := max downto min + 1 do
    begin
        // HeapPushDown.
        HeapPushDown(list, min, i);

        // Output the root.
        tmp := list^[min];
        list^[min] := list^[i];
        list^[i] := tmp;
    end;
end;

procedure TSortForm.DoCountingsort;
var
    start_time : TDateTime;
    rep, i     : Longint;
    counts     : PCountArray;
begin
    // Allocate space for the counts array;
    GetMem(counts, MaxValue * SizeOf(Longint));

    EllapsedTime := 0;
    for rep := 1 to NumReps do
    begin
        // Copy the unsorted list into the sorted array.
        for i := 1 to NumItems do
            SortedList^[i] := UnsortedList^[i];

        // Run the algorithm.
        start_time := Time;
        Countingsort(SortedList, counts, 1, NumItems, 1, MaxValue);
        EllapsedTime := EllapsedTime + Time - start_time;
    end;

    // Free the space allocated for the counts array.
    FreeMem(counts);
end;
procedure TSortForm.Countingsort(list : PLongintArray; counts : PCountArray; min, max, min_value, max_value : Longint);
var
    i, j, new_index : Longint;
begin
    // Initialize the counts to 0.
    for i := min_value to max_value do counts^[i] := 0;

    // Count the values.
    for i := min to max do
        counts^[list^[i]] := counts^[list^[i]] + 1;

    // Place the values in their correct locations.
    new_index := min;
    for i := min_value to max_value do
        for j := 1 to counts^[i] do
        begin
            list^[new_index] := i;
            new_index := new_index + 1;
        end;
end;

procedure TSortForm.DoLLBucketsort;
var
    start_time : TDateTime;
    rep        : Longint;
    top        : PCell;
begin
    EllapsedTime := 0;
    for rep := 1 to NumReps do
    begin
        // Build a linked list containing the unsorted items.
        top := BuildLinkedList;

        // Run the algorithm.
        start_time := Time;
        LLBucketsort(top);
        EllapsedTime := EllapsedTime + Time - start_time;

        // Copy the result into the sorted array.
        if (rep = NumReps) then CopyLinkedList(top);

        // Delete the sorted list.
        DeleteLinkedList(top);
    end;
end;
procedure TSortForm.LLBucketsort(top : PCell);
var
    count, min_value, max_value : Longint;
    i, value, bucket_num        : Longint;
    cell, nxt                   : PCell;
    bucket                      : PCellArray;
    scale                       : Double;
begin
    cell := top^.NextCell;
    if (cell = nil) then exit;

    // Count the cells and find the min and max values.
    count := 1;
    min_value := cell^.Value;
    max_value := min_value;
    cell := cell^.NextCell;
    while (cell <> nil) do
    begin
        count := count + 1;
        value := cell^.value;
        if (min_value > value) then min_value := value;
        if (max_value < value) then max_value := value;
        cell := cell^.NextCell;
    end;

    // If min_value = max_value, there is only one value
    // so the list is sorted.
    if (min_value = max_value) then exit;

    // If the list has no more than Cutoff cells, finish
    // with LLInsertionsort.
    if (count <= Cutoff) then
    begin
        LLInsertionsort(top);
        exit;
    end;

    // Allocate the empty buckets.
    GetMem(bucket, count * SizeOf(TCell));
    for i := 1 to count do bucket^[i].NextCell := nil;

    // Move the cells into the buckets.
    scale := (count - 1) / (max_value - min_value);
    cell := top^.NextCell;
    while (cell <> nil) do
    begin
        nxt := cell^.NextCell;
        value := cell^.value;
        if (value = max_value) then
            bucket_num := count
        else
            bucket_num :=
                Trunc((value - min_value) * scale) + 1;
        cell^.NextCell := bucket^[bucket_num].NextCell;
        bucket^[bucket_num].NextCell := cell;
        cell := nxt;
    end;

    // Recursively sort buckets with more than one cell.
    for i := 1 to count do
        if (bucket^[i].NextCell <> nil) then
            LLBucketsort(@bucket^[i]);

    // Merge the sorted lists.
    top^.NextCell := bucket^[count].NextCell;
    for i := count - 1 downto 1 do
    begin
        cell := bucket^[i].NextCell;
        if (cell <> nil) then
        begin
            nxt := cell^.NextCell;
            while ((nxt <> nil) and
                   (nxt^.value < INFINITY)) do
            begin
                cell := nxt;
                nxt := cell^.NextCell;
            end;
            cell^.NextCell := top^.NextCell;
            top^.NextCell := bucket^[i].NextCell;

            // Free the bottom sentinel if there is one.
            if (nxt <> nil) then Dispose(nxt);
        end;
    end;

    // Free the memory allocated for the buckets.
    FreeMem(bucket);
end;

procedure TSortForm.CheckResults;
var
    i : Longint;
begin
    for i := 2 to NumItems do
        if (SortedList^[i] < SortedList^[i - 1]) then
        begin
            Beep;
            ShowMessage('Error: Sort not correct.');
            exit;
        end;
end;

end.
