program quicksort_demo (infile1, output);

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      LIST ADT (an ARRAY implementataion)

NOTE:-     1. The array size is determined by maxln, and is set for 100
              elements.

           2. An empty list has the position variable L.last set to 0.}

const
  maxln = 100;
type
  position = integer;
  infotype = integer;
  keytype = infotype;
  list = record
           key: array[1..maxln] of infotype;
           last: position
         end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

var
  infile1: text;
  L: list;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure ERROR;
  begin
  { * * COMPILER SPECIFIC FEATURE FOLLOWS * *}
  abort('ERROR',0,0);
  { * * END CSF * *}
  end;
function FIRST (var L: list): position;
  begin
    FIRST:= 1
  end;
function ENDLIS (var L: list): position;
  begin
    ENDLIS:= L.last + 1
  end;
function NEXT (p: position; var L: list): position;
  begin
    if ((p > L.last) or (p < 1))
      then
        ERROR
      else
        NEXT:= p + 1
  end;
function RETRIEVE (p: position; var L: list): infotype;
  begin
    if ((p > L.last) or (p < 1))
      then
        ERROR
      else
        RETRIEVE:= L.key[p]
  end;
procedure DELETE (p: position; var L: list);
  var
    q: position;
  begin
    if ((p > L.last) or (p < 1))
      then
        ERROR
      else
        begin
          L.last:= L.last - 1;
          for q:= p to L.last do
            L.key[q]:= L.key[q+1]
        end
  end;
procedure MAKENULL (var L: list);
  begin
    L.last:= 0
  end;
procedure INSERT (x: infotype; p: position; var L: list);
  var
    q: position;
  begin
    if L.last >= maxln
      then
        ERROR
      else
        if ((p > L.last+1) or (p < 1))
          then
            ERROR
          else
            begin
              for q:=L.last downto p do
                L.key[q+1]:= L.key[q];
              L.last:= L.last+1;
              L.key[p]:= x
            end
  end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

procedure read_in (var f: text; var L: list);
    {read_in reads the input text file and puts the elements in list L. One
     single digit integer per line is the expected file format.}
  var
    p: position;
    v: infotype;
  begin
    p:= FIRST(L);
    while not eof(f) do
      begin
        readln (f,v);
        INSERT (v, p, L);
        p:= NEXT(p, L)
      end
  end;

procedure print_out (var L: list);
    {print_out prints list L, after a linefeed. The elements are expected to be
     single digit integers (a field width of 2 is used with no formatting) if
     this is not the case the output will look confused.}
  var
    p: position;
    c: integer;
  begin
    writeln;
    c:= 0;
    p:= FIRST(L);
    while p <> ENDLIS(L) do
      begin
        if ((c mod 8 = 0) and (c<>0)) then writeln;
        write (RETRIEVE(p, L):10);
        p:= NEXT(p, L);
        c:= c + 1
      end
  end;

procedure quicksort (i,j: integer; var A: list);
  {"i" is the lower index and "j" is the higher index in the array "A"}
  var
    pivot: keytype;  {the pivot value}
    pivotindex: integer; {the index for the pivot value}
    k: integer;    {beginning index for group of elements >= pivot}

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

           SUBROUTINES OF QUICKSORT}

  procedure swap (var i,j: keytype);
    {swaps the arguments "i" and "j"}
    var
      temp: keytype;
    begin
      temp:= i;
      i:= j;
      j:= temp
    end;
  function findpivot (i, j: integer; var A: list): integer;
    {"i" is lower and "j" is higher index in "A".  Returns zero if range
     consists of identical keys, otherwise returns the index of the larger
     of the first two distinct keys}
    var
      firstkey: keytype;  {value of first key in range}
      k: integer; {index moves along the range looking for next distinct key}
      done: boolean; {becomes true when two distinct keys found}
    begin
      firstkey:= A.key[i];
      done:= false;
      k:= i + 1;
      while ((k <= j) and (not done)) do
        begin
          if A.key[k] > firstkey
            then
              begin
                findpivot:= k;
                done:= true
              end
            else
              if A.key[k] < firstkey
                then
                  begin
                    findpivot:= i;
                    done:= true
                  end;
          k:= k + 1
        end;
      if not done then findpivot:= 0
    end;
  function partition (i, j: integer; pivot: keytype; var A: list): integer;
    {"i" is lower and "j" is higher index in "A". Partitions the range so
     keys < pivot are at the lower index values and keys >= pivot are at the
     higher index values. Returns the lowest index whose key value is equal
     to the pivot (where there are several elements with the pivot value)}
    var
      l, r: integer; {cursors}
    begin
      l:= i;
      r:= j;
      repeat
    {swap the 2 out-of-place elements (if they are NOT out-of-place on the
     FIRST pass, they will be swapped AGAIN on the second pass)}
        swap (A.key[l], A.key[r]);
    {move up from the lower index until a key value equal to (or greater than)
     the pivot value is encountered}
        while A.key[l] < pivot do
          l:= l + 1;
    {move down from the higher index until a key value less than the pivot
     value is encountered}
        while A.key[r] >= pivot do
          r:= r - 1
      until l>r; {the cursors have crossed each other, the whole range
                  has been scanned !}
      partition:= l  {lowest index with key value equal to the pivot}
    end;

{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

           MAIN QUICKSORT CODE STARTS HERE}

  begin
    pivotindex:= findpivot (i, j, A);
    if pivotindex <> 0  {zero indicates all keys equal}
      then
        begin
          pivot:= A.key[pivotindex];
          k:= partition (i, j, pivot, A);
          quicksort (i, k-1, A);  {sort elements < the pivot}
          quicksort (k, j, A)     {sort elements >= the pivot}
        end
  end;

    {     *  *  *     MAIN PROGRAM CODE STARTS HERE    *  *  *}

begin
  reset (infile1);
  MAKENULL(L);
  read_in (infile1, L);
  print_out (L);
  quicksort (FIRST(L), ENDLIS(L)-1, L);
  writeln;
  writeln;
  writeln;
  writeln ('  THE SORTED LIST APPEARS BELOW :- ');
  writeln;
  print_out (L)
end.
