BubbleSortDemo

To perform a bubble sort on an linked list of records, we must repeatedly compare adjacent pairs of record IDs and swap the order of the records if necessary. The following diagram illustrates how three pointers must change after a swap. We denote a record by appending a caret to its pointer in the same way that it is used in Pascal code.

Swapping pointers

Swapping pointers

After the swap:
  • PtrCurrent^.Next must contain the pointer that was PtrSucc^.Next.
  • PtrSucc^.Next must contain the pointer that was PtrPred^.Next.
  • PtrPred^.Next must contain the pointer that was PtrCurrent^.Next.

We must use a temporary variable to make this group of assignments correctly.

(The first record has no PtrPred^ record but if swapped, PtrFirst must be changed).

Before the next comparison is made:
  • PtrCurrent^ is now in the correct position to be the lower of the two compared records;
  • The new PtrSucc^ is the successor of the last compared pair and is already pointed to by PtrCurrent^.Next;
  • The new PtrPred^ is the old PtrSucc^ and its next pointer already points to PtrCurrent^.
If there is no swap, the .Next pointers are already correct and, to prepare for the next comparison:
  • The new PtrCurrent^ will be the old PtrSucc^;
  • The new PtrSucc^ will be the old successor of the old PtrSucc^;
  • The new PtrPred^ will be the old PtrCurrent^.

The first pass in a bubble sort is guaranteed to end with the last list item in its correct position. After the next pass, the penultimate item is in its correct position, and so on. The pointer PtrEnd changes after each pass so that we do not make unnecessary comparisons. The output for the supplied file Progs.txt is shown below. (This program uses the same test file as program LinkedListDemo).

Output from program BubbleSortDemo

Output from program BubbleSortDemo

program BubbleSortDemo;
  {$APPTYPE CONSOLE}
uses
  SysUtils, StrUtils;
type
  PtrProg = ^TProg;
  TProg = record
    ProgramID : integer;
    ProgName : string[15];
    ProgrammerID : integer;
    Next : PtrProg;
  end;
const
  FILENAME = 'Progs.txt';
var
  PtrFirst : PtrProg;
  Choice : integer;

procedure AppendRecord;
var
  PtrNew, PtrCurrent : PtrProg;
begin
  new(PtrNew);
  write('Program ID? ');
  readln(PtrNew^.ProgramID);
  write('Program Name? ');
  readln(PtrNew^.ProgName);
  write('Programmer ID? ');
  readln(PtrNew^.ProgrammerID);
  PtrNew^.Next := nil;
  if PtrFirst = nil then
    begin
      PtrFirst := PtrNew;
    end
  else
    begin
      PtrCurrent := PtrFirst;
      while PtrCurrent^.Next <> nil do
        begin
          PtrCurrent := PtrCurrent^.Next;
        end;//while
      PtrCurrent^.Next := PtrNew;
    end; //if
end;

procedure DisplayRecord(RecPtr : PtrProg);
begin
  writeln(' Program ID: ', RecPtr^.ProgramID,
          '   Name: ', RecPtr^.ProgName,
          DupeString(' ', 14 - Length(RecPtr^.ProgName)),
          '    Programmer ID: ', RecPtr^.ProgrammerID);
end;

procedure DisplayRecords;
var
  PtrCurrent : PtrProg;
begin
  if PtrFirst = nil then
    writeln('No records to display')
  else
    begin
      PtrCurrent := PtrFirst;
      repeat
        DisplayRecord(PtrCurrent);
        PtrCurrent := PtrCurrent^.Next;
      until PtrCurrent = nil;
    end;
end;

procedure BubbleSort;
var
  PtrCurrent, PtrPred, PtrSucc, PtrEnd, PtrTemp : PtrProg;
  NoSwaps : Boolean;
begin
  if PtrFirst = nil then
    begin
      writeln('No records to sort');
    end
  else
    begin
      if PtrFirst^.Next = nil then
        begin
          writeln('Cannot sort 1 record.')
        end
      else
        begin
          writeln(#13#10' Unsorted records: ');
          DisplayRecords;
          writeln;
          PtrEnd := nil;
          NoSwaps := False;
          while NoSwaps = False do
            begin  //start of loop comparing pairs of RecordIDs
              NoSwaps := True;
              PtrSucc := PtrFirst^.Next;
              PtrCurrent := PtrFirst;
              PtrPred := nil;
              while PtrSucc <> PtrEnd do
                begin
                  write(' Comparing ',PtrCurrent^.ProgramID,
                        ' with ',PtrCurrent^.Next^.ProgramID);
                  if PtrCurrent^.ProgramID > PtrSucc^.ProgramID then
                    begin
                      writeln (' - swapping');
                      Noswaps := False;
                      PtrTemp := PtrSucc^.Next; //Save pointer
                      PtrSucc^.Next := PtrCurrent;
                      if PtrPred = nil then //Swap first two records and prepare for next swap
                        begin
                          //New first will be old second. Its .Next has been set already
                          PtrFirst := PtrSucc;
                        end
                      else
                        begin
                          PtrPred^.Next := PtrSucc;
                        end;
                      PtrPred := PtrSucc; //New Pred. Its .Next must point to new Current
                      //New Succ will be successor of old Succ. Its pointer is OK
                      PtrSucc := PtrTemp;
                      PtrCurrent^.Next := PtrSucc;
                      PtrPred^.Next := PtrCurrent;
                    end
                  else  //No swap
                    begin
                      writeln (' - swap not required');
                      //Prepare for new comparison
                      PtrPred := PtrCurrent;
                      PtrCurrent := PtrSucc;
                      PtrSucc := PtrSucc^.Next;
                    end;
                end;//while PtrSucc <> PtrEnd
                writeln(#13#10' Records after current pass:');
                PtrEnd := PtrCurrent;
                DisplayRecords;
                writeln;
            end; //while NoSwaps = False;
        end; //if
    end;//if
end;

procedure Init;
begin
  PtrFirst := nil;
end;

procedure LoadRecords;
var
  ProgFile : file of TProg;
  PtrNewRecord, PtrPreviousRecord : PtrProg;
begin
  assignFile(ProgFile, FILENAME);
  reset(ProgFile);
  new(PtrNewRecord);
  PtrFirst := PtrNewRecord;
  read(ProgFile, PtrNewRecord^);
  while not eof(Progfile) do
    begin
      PtrPreviousRecord := PtrNewRecord;
      new(PtrNewRecord);
      PtrPreviousRecord^.Next := PtrNewRecord;
      read(ProgFile, PtrNewRecord^);
    end;
  closeFile(ProgFile);
end;

begin
  Init;
  repeat
    writeln(#13#10'Would you like to ...');
    writeln('1 - Append a record?');
    writeln('2 - Load records?');
    writeln('3 - Display records?');
    writeln('4 - Sort by Program ID?');
    writeln('5 - Quit?');
    readln(Choice);
  case choice of
    1 : AppendRecord;
    2 : LoadRecords;
    3 : DisplayRecords;
    4 : BubbleSort;
  end;
  until Choice = 5;
end.
Programming - a skill for life!

Introduction to linked lists including arrays of records