Implementing Sort Algorithm in Delphi

QuickSort Algorith

One of the common problems in programming is to sort an array of values in some order (ascending or descending).

While there are many "standard" sorting algorithms, QuickSort is one of the fastest.

Quicksort sorts by employing a divide and conquer strategy to divide a list into two sub-lists.

The basic concept is to pick one of the elements in the array, called a pivot.

Around the pivot, other elements will be rearranged.

Everything less than the pivot is moved left of the pivot - into the left partition.

Everything greater than the pivot goes into the right partition.

At this point each partition is recursively "quick sorted".

Here's QuickSort algorithm implemented in Delphi:

procedure QuickSort( var A: array of integer; iLo, iHi: integer );
var
  Lo, Hi, Pivot, T: integer;
begin
  Lo := iLo;
  Hi := iHi;
  Pivot := A[ ( Lo + Hi ) div 2 ];
  repeat
    while A[ Lo ] < Pivot do
      Inc( Lo );
    while A[ Hi ] > Pivot do
      Dec( Hi );
    if Lo <= Hi then
    begin
      T := A[ Lo ];
      A[ Lo ] := A[ Hi ];
      A[ Hi ] := T;
      Inc( Lo );
      Dec( Hi );
    end;
  until Lo > Hi;

  if Hi > iLo then
    QuickSort( A, iLo, Hi );

  if Lo < iHi then
    QuickSort( A, Lo, iHi );
end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  QuickSort( intArray, Low( intArray ), High( intArray ) ) ;
end;

Note: in practice, the QuickSort becomes very slow when the array passed to it is already close to being sorted.

Note: There's a demo program that ships with Delphi, called "thrddemo" in the "Threads" folder

which shows additional two sorting alorithms: Bubble sort and Selection Sort

BubbleSort Algorith

procedure BubbleSort( var Vetor: Array of integer );
var
  i, temp: integer;
  changed: Boolean;
begin
  changed := True;

  while changed do
  begin
    changed := False;
    for i := Low( Vetor ) to High( Vetor ) - 1 do
    begin
      if ( Vetor[ i ] > Vetor[ i + 1 ] ) then
      begin
        temp := Vetor[ i + 1 ];
        Vetor[ i + 1 ] := Vetor[ i ];
        Vetor[ i ] := temp;
        changed := True;
      end;
    end;
  end;
end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  BubbleSort( intArray ) ;
end;

Selection Sort Algorith

procedure SelectionSort( var A: Array of integer );
var
  X, i, J, M: integer;
begin
  for i := Low( A ) to High( A ) - 1 do
  begin
    M := i;
    for J := i + 1 to High( A ) do
      if A[ J ] < A[ M ] then
        M := J;
    X := A[ M ];
    A[ M ] := A[ i ];
    A[ i ] := X;
  end;
end;

Usage :

var
  intArray : array of integer;
begin
  SetLength(intArray,10) ;
 
  //Add values to intArray
  intArray[0] := 2007;
  ...
  intArray[9] := 1973;
 
  //sort
  SectionSort( intArray ) ;
end;

unit uSort;

{ These sort routines are for arrays of Integers.
  Count is the maximum number of items in the array. }

INTERFACE

type
  Sortarray = array [ 0 .. 0 ] OF Word;

function BinarySearch( var A; X : Integer; Count : Integer ) : Integer;
function SequentialSearch( var A; X : Integer; Count : Integer ) : Integer;

procedure BubbleSort( var A; Count : Integer ); { slow }
procedure CombSort( var A; Count : Integer );
procedure QuickSort( var A; Count : Integer ); { fast }
procedure ShellSort( var A; Count : Integer ); { moderate }

IMPLEMENTATION

{ Local procedures and functions }
procedure Swap( var A, B : Word );
var
  C : Integer;
begin
  C := A;
  A := B;
  B := C;
end;

{ Global procedures and functions }
function BinarySearch( var A; X : Integer; Count : Integer ) : Integer;
var
  High, Low, Mid : Integer;
begin
  Low := 1;
  High := Count;
  while High >= Low do
  begin
    Mid := Trunc( High + Low ) DIV 2;
    if X > Sortarray( A )[ Mid ] then
      Low := Mid + 1
    else if X < Sortarray( A )[ Mid ] then
      High := Mid - 1
    else
      High := -1;
  end;
  if High = -1 then
    BinarySearch := Mid
  else
    BinarySearch := 0;
end;

function SequentialSearch( var A; X : Integer; Count : Integer ) : Integer;
var
  i : Integer;
begin
  for i := 1 to Count do
    if X = Sortarray( A )[ i ] then
    begin
      SequentialSearch := i;
      Exit;
    end;
  SequentialSearch := 0;
end;

procedure BubbleSort( var A; Count : Integer );
var
  i, j : Integer;
begin
  for i := 2 to Count do
    for j := Count downto i do
      if Sortarray( A )[ j - 1 ] > Sortarray( A )[ j ] then
        Swap( Sortarray( A )[ j ], Sortarray( A )[ j - 1 ] );
end;

procedure CombSort( var A; Count : Integer );
{ The combsort is an optimised version of the bubble sort. It uses a }
{ decreasing gap in order to compare values of more than one element }
{ apart.  By decreasing the gap the array is gradually "combed" into }
{ order ... like combing your hair. First you get rid of the large }
{ tangles, then the smaller ones ... }
{ There are a few particular things about the combsort. }
{ Firstly, the optimal shrink factor is 1.3 (worked out through a }
{ process of exhaustion by the guys at BYTE magazine). Secondly, by }
{ never having a gap of 9 or 10, but always using 11, the sort is }
{ faster. }
{ This sort approximates an n log n sort - it's faster than any other }
{ sort I've seen except the quicksort (and it beats that too sometimes). }
{ The combsort does not slow down under *any* circumstances. In fact, on }
{ partially sorted lists (including *reverse* sorted lists) it speeds up. }
CONST
  ShrinkFactor = 1.3; { Optimal shrink factor ... }
var
  Gap, i, Temp : Integer;
  Finished : Boolean;
begin
  Gap := Trunc( ShrinkFactor );
  REPEAT
    Finished := TRUE;
    Gap := Trunc( Gap / ShrinkFactor );
    if Gap < 1 then { Gap must *never* be less than 1 }
      Gap := 1
    else if Gap IN [ 9, 10 ] then { Optimises the sort ... }
      Gap := 11;
    for i := 1 to ( Count - Gap ) do
      if Sortarray( A )[ i ] < Sortarray( A )[ i + Gap ] then
      begin
        Swap( Sortarray( A )[ i ], Sortarray( A )[ i + Gap ] );
        Finished := FALSE;
      end;
  UNTIL ( Gap = 1 ) AND Finished;
end;

procedure QuickSort( var A; Count : Integer );

  procedure PartialSort( LowerBoundary, UpperBoundary : Integer; var A );
  var
    ii, l1, r1, i, j, k : Integer;
  begin
    k := ( Sortarray( A )[ LowerBoundary ] + Sortarray( A )
      [ UpperBoundary ] ) DIV 2;
    i := LowerBoundary;
    j := UpperBoundary;
    REPEAT
      while Sortarray( A )[ i ] < k do
        Inc( i );
      while k < Sortarray( A )[ j ] do
        Dec( j );
      if i <= j then
      begin
        Swap( Sortarray( A )[ i ], Sortarray( A )[ j ] );
        Inc( i );
        Dec( j );
      end;
    UNTIL i > j;
    if LowerBoundary < j then
      PartialSort( LowerBoundary, j, A );
    if i < UpperBoundary then
      PartialSort( UpperBoundary, i, A );
  end;

begin
  PartialSort( 1, Count, A );
end;

procedure ShellSort( var A; Count : Integer );
var
  Gap, i, j, k : Integer;
begin
  Gap := Count DIV 2;
  while ( Gap > 0 ) do
  begin
    for i := ( Gap + 1 ) to Count do
    begin
      j := i - Gap;
      while ( j > 0 ) do
      begin
        k := j + Gap;
        if ( Sortarray( A )[ j ] <= Sortarray( A )[ k ] ) then
          j := 0
        else
          Swap( Sortarray( A )[ j ], Sortarray( A )[ k ] );
        j := j - Gap;
      end;
    end;
    Gap := Gap DIV 2;
  end;
end;

end.