Return to Mr Belvedere's Programming Nook


Quick Sort
© 1996 by Bobby Griggs.


(**************************************************************************)
(*                                                                        *)
(*      Robert C. Griggs, Jr.                                             *)
(*      Program name - QUIKFILE.PAS                                       *)
(*      October 4, 1991                                                   *)
(*                                                                        *)
(**************************************************************************)

program quiktest (input,output);
{$M 65520,0,655360}

uses dos;

const
     MAX=1000;               {maximum elements in array to hold numbers}
     MIN=1;                   {minimum element identifier for array}
     NUMFILE='books.dat';   {input file}
     NUMSORT='booktemp.dat';  {sorted output file}

type
     teacher_record = record
                           student:string[20];
                           book:string[20];
                           bookno:integer;
                           teacher:string[20];
                           price:real;
                           recnum:integer;
                      end;   {teacher_record}
     bookarr = array[0..MAX] of teacher_record;  {definition of array}
     bookfile = file of teacher_record;

var
     books:bookarr;
     infile,            {input data}
     sortfile:bookfile;      {sorted data}
     items:integer;

(***************************************************************************)

(* Procedure to load the input file into the array                         *)

procedure loadarray (var books:bookarr;var items:integer);

     var
          counter:integer;         {counter for loading the array}
          s:pathstr;

     begin  {loadarray}

          assign (infile,NUMFILE);
          s:=fsearch(infile);
          if s='' then
               reset (infile);
          else
               begin  {else statement}
                    writeln ('The input file does not exists!');
                    halt();
               end;   {else statement}
          counter:=0;
          while not eof(infile) and (counter <= max) do
               begin  {while statement}
                    readln (infile,books[counter]);
                    if not eof(infile) then
                         counter:=counter + 1;
               end;   {while statement}
          close (infile);
          items:=counter;
     end;   {loadarray}

(***************************************************************************)

(* procedure to execute quicksort                                          *)

procedure quicksort (left,right:integer);

     var
          pivot,         {pivot element for sort}
          i,             {scanning position}
          j,             {scanning position}
          temp:integer;  {for swaps}

     begin  {quicksort}

          i:=left;  {sets position for scanning left side of array}
          j:=right;  {sets position for scanning right side of array}
          pivot:=(i + j) div 2;  {establishes pivot point}
          repeat
               while books[i].student < books[pivot].student do
                    i:=i + 1;  {scan for larger element}
               while books[j].student > books[pivot].student do
                    j:=j - 1;  {scan for smaller element}
               if books[i].student <= books[j].student then
                    begin  {if statement}
                         temp:=books[i];
                         books[i]:=books[j];
                         books[j]:=temp;
                         i:=i + 1;
                         j:=j - 1;
                    end;   {if statement}
          until (i > j);  {continue sorting each partition}
          if left < j then quicksort(left,j);  {do left side partition}
          if i < right then quicksort(i,right);  {do right sided partition}

     end;   {quicksort}

(***************************************************************************)

(* procedure to write the sorted numbers to a file                         *)

procedure writefile (items:integer);

     var
          counter:integer;  {for use in for loop}

     begin  {writefile}

          assign (sortfile,numsort);
          rewrite (sortfile);
          for counter:=1 to items do
               writeln (sortfile,books[counter]);
          close (sortfile);

     end;   {writefile}

(***************************************************************************)

     begin  {main}

          loadarray;
          quicksort (min,items);
          writefile;

     end.   {main}