Sort Procedures

Rather than just give you BubbleQ sort code, I have included here code for several popular sort algorithms. In each of these, the array to be sorted is named arr and is of type list = array [1..100] of string. The array count is sent through the parameter max. Several of these procedures call upon the procedure swap which you must provide yourself!

BubbleQ Sort

The bubbleq sort makes several passes through the data, just like the bubble sort, exchanging pairs of elements that are out of order. The difference is that rather than swapping items i and i+1, we swap items i and i+gap. In this way, out-of-place elements move farther faster - this is the secret to all the fast sorts. Then on successive passes, we reduce the size of gap until it finally reaches 1, so that final adjustments to the data positions can be made.

PROCEDURE bubbleq (var arr:list; max:integer);
{from Byte, April 1991, p 317}
VAR
  i, j, gap : integer;
  done : boolean;
BEGIN
  gap := max;
  REPEAT
    done := true;
    gap := trunc(gap/1.3);
    IF gap<1 THEN
      gap := 1;
    FOR i:=1 TO max-gap DO
      BEGIN
        j := i+gap;
        IF arr[i]>arr[j] THEN
          BEGIN
            done := false;
            swap(arr[i],arr[j]);
          END;
      END;
  UNTIL (gap=1) AND done;
END;

Shell's Sort

Shell developed this sort procedure in the 60's - the bubbleq sort is really a variation of this classic routine. Like the bubbleq it works by swapping elements that are gap apart, reducing the size of gap on each pass. But on each separate pass, it uses an insertion sort technique rather than a bubble sort. Note the line

  gap := max SHR 1;

This line does the same thing as gap := max DIV 2, only faster. Much research has been done on what size gaps to use - this version of Shell's sort uses just one such option.

PROCEDURE shell (var arr:list; max:integer);
VAR
  gap, i, j : integer;
BEGIN
  gap := max SHR 1;
  WHILE gap >= 1 DO
    BEGIN
      FOR i:= gap+1 TO max DO
        BEGIN
          j := i-gap;
          WHILE j>=1 DO
            IF arr[j]<arr[j+gap] THEN
              j := 0
            ELSE
              BEGIN
                swap(arr[j],arr[j+gap]);
                j := j-gap;
              END
        END;
      gap := gap SHR 1
    END;
END;

Insertion Sort

In this variation of the insertion sort, on pass 1 we insert item 2 into its correct position relative to item 1. On pass 2 we insert item 3 into position with (the now sorted) items 1 and 2. On pass k we insert item k+1 into the (sorted) items 1 though k.

PROCEDURE insertion (var arr:list; max:integer);
VAR
  j, k, p : integer;
  s : string;
BEGIN
  FOR j:=2 TO max DO
    BEGIN
      s := arr[j];
      p := j-1;
      WHILE (p>0) AND (s<arr[p]) DO
        BEGIN
          arr[p+1] := arr[p];
          p := p-1;
        END;
      arr[p+1] := s
    END
END;

Selection Sort

On pass 1 we scan the entire list looking for the smallest item, and place it in location 1. On pass j we scan the remainder of the list looking for the smallest remaining item, and place it in location j.

PROCEDURE select (var arr:list; max:integer);
VAR
  j, k, p : integer;
  m : string;
BEGIN
  FOR j:=1 TO max-1 DO 
    BEGIN
      m := arr[j];
      p := j;
      FOR k:=j+1 TO max DO 
        IF arr[k]<m THEN
          BEGIN
            m := arr[k];
            p := k
          END;
      arr[p] := arr[j];
      arr[j] := m;
    END;
END;

Quick Sort

Quicksort uses recursion to sort smaller and smaller pieces of the target array. By packaging the actual Sort procedure within the framework of the procedure QuickSort, recursion overhead is minimized. Nevertheless, this procedure can still generate a stack/heap collision for certain arrangements of data. Caution! Since this procedure uses recursion, it can produce devastating results if things go wrong. Be sure to code it carefully if you choose to use it.

PROCEDURE quick (var arr:list; max:integer);

PROCEDURE sort(l,r: integer);
VAR
  i, j : integer;
  x : string;
BEGIN
  i := l;
  j := r;
  x := arr[(l+r) DIV 2];
  REPEAT
    WHILE arr[i]<x DO
      i := i+1;
    WHILE x<arr[j] DO
      j := j-1;
    IF i<=j THEN
      BEGIN
        swap(arr[i],arr[j]);
        i := i+1;
        j := j-1;
      END;
  UNTIL i>j;
  IF l<j THEN
    sort(l,j);
  IF i<r THEN
    sort(i,r);
END;

BEGIN {quicksort};
  sort(1,max);
END;

QQuick Sort

This variation on the quick sort also uses recursion, breaking the data into smaller and smaller pieces for sorting. It differs essentially in the order in which the pieces are considered. As with the earlier quick sort code, by packaging the actual qsort procedure within the framework of the procedure qqsort, recursion overhead is minimized. Nevertheless, this procedure can still generate a stack/heap collision for certain arrangements of data. Caution! Since this procedure uses recursion, it can produce devastating results if things go wrong. Be sure to code it carefully if you choose to use it.

PROCEDURE qqsort (var arr:list; max:integer);

PROCEDURE qsort(bot,top:integer);
VAR
  i, j : integer;
  temp : string;
BEGIN
  WHILE bot<top DO
    BEGIN
      i := bot;
      j := top;
      temp := arr[bot];
      WHILE i<j DO
        BEGIN
          WHILE arr[j]>temp DO
            j := j-1;
          arr[i] := arr[j];
          WHILE (i<j) AND (arr[i]<=temp) DO
            i := i+1;
          arr[j] := arr[i];
        END;
      arr[i] := temp;
      qsort(bot,i-1);
      bot := i+1;
    END;
END;

BEGIN
  qsort(1,max);
END;