Abcol Logo

You have now reached Chrissie's web pages for

Pascal Programming

Sorting Algorithms and Code.

You may wish, for various reasons, to sort certain data items in order in your Pascal programs. To create a new list of sorted items from a random one, items are normally swapped in pairs according to some pre-determined algorithm, until the sorting process is complete.

Swaps are made (or not) based on the comparison of two items, so the number of comparisons required is also a measure of how efficient your algorithm is!

There are many types (and books written about them) of data sorting algorithms. Four of the main ones are the bubble sort, the insertion sort, the Shell-Metzner sort and the quick sort. These all have different criteria for choosing the two items to be compared, and vary in complexity and performance.

In the code that follows, I have used 15000 randomly generated numbers as my list of items to swap. I have also included a very simple timer, based on taking numbers from the system clock, so that you can compare results for the different methods.

The Bubble Sort.

This is the "classic" Pascal sort and is the first type that most students learn. It works by starting at the beginning of the list, comparing adjacent items. If the big item is before the wee one, the two are swapped. We then move on to the next two items until we reach the end of the list. This makes the first pass of the list.

On the second pass, we know that the bottom item must be the biggest. So we only have to compare and swap to the penultimate item.

This cycle continues, including one less item every time, until the whole list is sorted.

There are enhancements to this basic sort. One is to add a boolean flag, e.g. "Finished", to the loop so that if no swaps were made during that particular pass, the list must be fully sorted.

Here is the source code for a basic Bubble Sort.

PROGRAM Bubblesort (input, output, numberfile);
{a program to demonstrate bubble sort on a file of 15000 random integers}
{written by C Nyssen Wednesday, March 12, 2003}
{version 1.10}

CONST maxnum = 15000;

TYPE numberarray = ARRAY [1..maxnum] of INTEGER;

VAR   list: numberarray;
   numberfile: FILE OF integer;
   lastnumber, swaps, comparisons, x: integer;
   finished, OK: boolean;
   start, finish: string;

FUNCTION timer (start, finish: string):integer;
{a function to return time taken in seconds, to complete a given task}
{WARNING! Do not run this past MIDNIGHT or you will get a false result}
VAR s1, s2, m1, m2, h1, h2, ss, ff: integer; tc: char;

BEGIN
    {calculate start time in seconds first}
    tc :=(SUBSTR (start, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 1, 1)); h1 := ORD(tc) - 48;
    
    ss:=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;
    
    {calculate finish time in seconds}
    tc :=(SUBSTR (finish, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 1, 1)); h1 := ORD(tc) - 48;
    ff :=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    timer := ff-ss;
END;

PROCEDURE swapitems (VAR list: numberarray; VAR x,swaps: integer; VAR finished: boolean);

{purpose of procedure is to swap position of 2 items in list}
VAR pot: integer;

BEGIN
    pot := list[x];
    list[x] := list[x+1];
    list [x+1 ] := pot;
    swaps := swaps + 1;
    finished := false;
END;

BEGIN {main}
    RESET (numberfile, 'Numbers.dat', OK);
    FOR x := 1 TO maxnum DO
    BEGIN
         read (numberfile, list[x]);
         write (list[x]:7);
         IF x MOD 10 = 0 THEN readln;
    END;
    lastnumber := maxnum - 1; swaps := 0; comparisons := 0;
    CLOSE (numberfile);

    start := time;
    REPEAT {until all the numbers are sorted}
         finished := true;
         FOR x := 1 TO lastnumber DO
         BEGIN
               IF list[x] > list[x + 1] THEN
               BEGIN
                    swapitems (list, x, swaps, finished);
               END;
               comparisons := comparisons + 1;
         END;
         lastnumber := lastnumber - 1;
    UNTIL finished;
    finish := time;

    FOR x := 1 TO maxnum DO
    BEGIN
         write (list[x]: 7);
        IF x MOD 10 = 0 THEN readln;
    END;
    readln;

    writeln;
    writeln ('Total comparisons => ', comparisons);
    writeln ('Total swaps => ', swaps);
    writeln ('Time elapsed => ', timer(start, finish));

END.

Back to TOP

Insertion Sort

The Insertion Sort uses 2 lists - the "full" random one, and an empty one. Each time an item is scrutinised, it gets moved to the "correct" place in the empty list.

With some clever programming, both "lists" can occupy the same memory space; the first shrinks as items are taken away, and the second grows as items are added. This gives us the principle of the Insertion Sort.

Another form of the Insertion Sort, which is even more efficient, is an Insertion Sort with Binary Search, but this is a project for another day! Below is an example of a basic Insertion Sort.

PROGRAM Insert (input, output, numberfile);
{a program to demonstrate insertion sort on a file of 15000 random integers}
{written by C Nyssen Thursday, June 17th, 2004}
{version 1.00}

CONST maxnum = 15000;

TYPE numberarray = ARRAY [1..maxnum] of INTEGER;

VAR
    list : numberarray;
    numberfile: FILE OF integer;
    currentnumber, insertnumber, lastnumber, comparisons, swaps, insertpointer, count : integer;
    {the output list starts at the top of the array and grows to replace items removed from the input list}
    start, finish: string;
    OK: boolean; {flag to check that the file of random numbers has opened correctly}

FUNCTION timer (start, finish: string):integer;
{a function to return time taken in seconds, to complete a given task}
{WARNING! Do not run this past MIDNIGHT or you will get a false result}
VAR s1, s2, m1, m2, h1, h2, ss, ff: integer; tc: char;

BEGIN
    {calculate start time in seconds first}
    tc :=(SUBSTR (start, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 1, 1)); h1 := ORD(tc) - 48;

    ss:=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    {calculate finish time in seconds}
    tc :=(SUBSTR (finish, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 1, 1)); h1 := ORD(tc) - 48;
    ff :=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    timer := ff-ss;
END;

PROCEDURE findplace (VAR insertpointer, comparisons, swaps: integer);
{finds place for the insertion of the current item being looked at}
BEGIN
    insertpointer := 0;
    REPEAT
        insertpointer := insertpointer+1;
        comparisons := comparisons+1;
    UNTIL (currentnumber < list[insertpointer]) OR (insertpointer = insertnumber);
END;
{procedure exits with insertpointer pointing at place to insert currentnumber after moving all other items in output list down}

PROCEDURE insert (VAR list: numberarray; VAR swaps: integer);

VAR k: integer;

BEGIN
    IF (insertpointer <> insertnumber) THEN
    BEGIN
        FOR k := lastnumber DOWNTO insertpointer DO
        BEGIN
            List [k+1] := List[k];
            {move all the items along one place to make room}
            swaps := swaps+1;
        END;
    list [insertpointer] := currentnumber;
    {insert the current item in it's place}
    swaps := swaps+1;
    END;
END;

BEGIN {main program}
    RESET (numberfile,'Numbers.dat', OK);
    FOR count := 1 TO maxnum DO
        READ (numberfile, list[count]);
        {gets list from data file and puts the items into the array}
    CLOSE (numberfile);
    Lastnumber := 1; insertnumber := 2; comparisons := 0; swaps := 0; count := 1; {initialises the variables to start}

    Start:= time; {start the timer}

    REPEAT {until all the numbers are sorted}
        currentnumber := list[count];
        findplace (insertpointer, comparisons, swaps);
        insert (list, swaps);
        lastnumber := lastnumber+1;
        insertnumber := lastnumber+1;
    UNTIL (lastnumber = maxnum);

    Finish := time; {stop the timer}

    FOR count := 1 TO maxnum DO
    BEGIN
        write (list[count]:7);
        IF (count MOD 10 = 0) THEN writeln;
    END;

    writeln;
    writeln ('Total comparisons => ', comparisons);
    writeln ('Total Swaps => ', swaps);
    writeln ('Time Elapsed => ', timer (start, finish));

END.

Back to TOP

Shell-Metzner Sort

The next sort, which is quite complex, is the Shell-Metzner sort, names after the two guys who invented it.

This works by first comparing items that are far apart, and then gradually reducing the comparison "jump" until it is the items next to each other that are being compared.

The compare interval could start at half the list length, but for some reason, using prime numbers gives better results. Usually the compare interval is based on (the power of 2 which comes closest to the length of the list, less 1). So for 100 items, the comparison would be based on ((2 ^ 6 = 64) - 1) i.e. 63.

Shell and Metzner's theory was that moving things longer distances at the start, would reduce the overall work to be done. If you compile and run this and compare it to the bubble sort, you will see that this certainly seems to be the case.

PROGRAM shell (input, output, numberfile);
{a program to demonstrate Shell-Metzner sort on a file of 15000 random integers}
{written by C Nyssen Wednesday, March 19, 2003}
{version 1.10}

CONST maxnum = 15000;
      firstint = 47;

TYPE numberarray = ARRAY [1..maxnum] of INTEGER;
     
VAR interval, x, index, comparisons, swaps, item: integer;
    list: numberarray;
    numberfile: FILE OF integer;
    swapped, ok : boolean;
    start, finish: string;

FUNCTION timer (start, finish: string):integer;
{a function to return time taken in seconds, to complete a given task}
{WARNING! Do not run this past MIDNIGHT or you will get a false result}
VAR s1, s2, m1, m2, h1, h2, ss, ff: integer; tc: char;

BEGIN
    {calculate start time in seconds first}
    tc :=(SUBSTR (start, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 1, 1)); h1 := ORD(tc) - 48;

     ss:=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    {calculate finish time in seconds}

    tc :=(SUBSTR (finish, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 1, 1)); h1 := ORD(tc) - 48;
    ff:= (((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    timer := ff-ss;
END;  

PROCEDURE swapitems (VAR list: numberarray; VAR item ,swaps: integer; VAR swapped: boolean);
{purpose of procedure is to swap position of 2 items in list}
VAR  pot: integer;

BEGIN
    pot := list[item];
    list[item] := list [item+1];
    list [item+1] := pot;
    swaps := swaps + 1;
    swapped := true;
END; 

BEGIN
  {initialise the vars}
  interval := firstint; x := 1; swaps := 0; comparisons := 0; item := 1; 
  
  {open the file and read the numbers into the list}
  RESET (numberfile, 'Numbers.dat', OK);
  FOR index := 1 TO maxnum DO
    READ (numberfile, list[index]);
  
  start := time; {start the timer}
 
  REPEAT
     swapped := false;
     comparisons := comparisons + 1;
     IF list[item] > list [item + interval] THEN
     {compare item with next one 47 spaces further along}  
     BEGIN
        swapitems(list, item, swaps, swapped);
        item := item - interval;
     END;
     IF (NOT swapped) OR (item < 1) {i.e. we've gone past the end of list} THEN
     BEGIN
        x := x + 1;
        IF x > (maxnum - interval) THEN BEGIN
           interval := interval DIV 2;
           x := 1;
        END;
        item := x;
     END;
  UNTIL interval = 0; {i.e. all the numbers are sorted now}

  finish := time; {stop timer}

  FOR index := 1 TO maxnum DO BEGIN
     write (list[index]:7);
  END;
  writeln;

  writeln ('Comparisons => ', comparisons);
  writeln ('Swaps => ', swaps);
  writeln ('Time elapsed => ', timer(start, finish));

  END.

Back to TOP

Quick Sort

This sort uses a stack and recursion. It is very complex compared to the others, but as the name suggests, it is very much quicker!

We first divide the list in two, and use the middle item as a comparator. It then searches to the left for a bigger item and to the right for a smaller one. When it finds these two items, it swaps them. This process continues until the two search pointers coincide or cross over.

One of the disadvantages of this arrangement is that items of equal value can be swapped, which is wasteful in time and resources.

PROGRAM quicksort (input, output, numberfile);
{a program to demonstrate Quicksort on a file of 15000 random integers}
{written by C Nyssen Friday, March 21, 2003}
{version 1.10}

CONST maxnum = 15000;

TYPE numberarray = ARRAY [1..maxnum] of INTEGER;

VAR count, swaps, level, comparisons, maxlevel, first, last: integer;
   list: numberarray;
   OK: boolean;
   start, finish: string;
   numberfile: FILE OF integer;
   

FUNCTION timer (start, finish: string):integer;
{a function to return time taken in seconds, to complete a given task}
{WARNING! Do not run this past MIDNIGHT or you will get a false result}
VAR s1, s2, m1, m2, h1, h2, ss, ff: integer; tc: char;

BEGIN
    {calculate start time in seconds first}
    tc :=(SUBSTR (start, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (start, 1, 1)); h1 := ORD(tc) - 48;

    ss:=(((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    {calculate finish time in seconds}

    tc :=(SUBSTR (finish, 8, 1)); s2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 7, 1)); s1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 5, 1)); m2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 4, 1)); m1 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 2, 1)); h2 := ORD(tc) - 48;
    tc :=(SUBSTR (finish, 1, 1)); h1 := ORD(tc) - 48;
    ff:= (((((h1*10)+h2)*60)+(m1*10)+m2)*60)+(s1*10)+s2;

    timer := ff-ss;
END;

PROCEDURE swapitems (VAR i, j, swaps: integer; VAR list: numberarray);

{purpose of procedure is to swap position of 2 items in list}
VAR  pot: integer;

BEGIN
    pot := list[i];
    list[i] := list[j];
    list[j] := pot;
    swaps := swaps + 1;
END;

PROCEDURE sortitems (VAR first, last, level, maxlevel, comparisons: integer; VAR list: numberarray);

VAR i, j, x : integer;

BEGIN
  i := first; j := last;
  x := list [((first + last) DIV 2)];
  level := level + 1;
     
  IF level > maxlevel THEN maxlevel := level;

  REPEAT
     WHILE (list[i]< x) DO BEGIN
        i := i + 1; comparisons := comparisons + 1;
     END{while};
     Comparisons := comparisons + 1;     {to account for the last comparison that ended the WHILE loop!}

     WHILE (x < list[j]) DO BEGIN
        j := j - 1; comparisons := comparisons + 1;
     END{while};
     Comparisons := comparisons + 1;    {to account for the last comparison that ended the WHILE loop!}

     IF i <= j THEN
     BEGIN
        swapitems (i, j, swaps, list);
        i := i + 1;
        j := j - 1;
     END;
  UNTIL i > j;

  IF first < j THEN sortitems (first, j, level, maxlevel, comparisons, list);
  IF i < last THEN sortitems (i, last, level, maxlevel, comparisons, list);
  level := level - 1;              {increment recursion level on exiting procedure}
END;

BEGIN {main program}
  {initialise the vars}
  swaps := 0; comparisons := 0; level := 0; maxlevel := 0; {maxlevel is maximum level of recursion}
  first := 1; last := maxnum;
  {open the file and read the numbers into the list}
  RESET (numberfile, 'Numbers.dat', OK);
  FOR count := 1 TO maxnum DO BEGIN
     READ (numberfile, list[count]);
     writeln (list[count]);
  END{for};
  start := time; {start the timer}

  sortitems (first, last, level, maxlevel, comparisons, list);

  finish := time; {stop timer}

  FOR count := 1 TO maxnum DO BEGIN
     write (list[count]:7);
  END;

  writeln;

  writeln ('Comparisons => ', comparisons);
  writeln ('Swaps => ', swaps);
  writeln ('Time elapsed => ', timer(start, finish));       

END.

Back to TOP

You may find it interesting to compile and run all four programs, using the same file of numbers, to compare their speed and efficiency. The source code for all the files can be found here. Compile and run the Random.p file first, to create the random file of 15000 integers.

Architecture Home Pascal Home Web Design Home Java Stuff Home Extra Stuff Home Other Stuff Home

Comments? c.nyssen@abcol.ac.uk
Last Updated - 18/07/04

Best viewed at 800x600 in 16-bit high color with Trebuchet MS installed. If you do not have this font, click here