Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ASORTS.ZIP/TSTSRT.PAS

Pascal/Delphi Source File | 1993-01-04 | 5.6 KB | 168 lines

program tstsrt;
{ Exercises most of the facilities of the ASORTS unit }

uses asorts;

{ $define MONITOR} {<-- MONITOR needs to be defined in ASORTS.PAS
                        also }

const
  max = 19; { must be byte-sized }

type
  list = array[1..max] of integer;

var
  data,data2: list;
  i: integer;
  b:integer;
  sortcount,qsc:integer;

const
  bs : set of byte = [];
  cmax:word=0;

function intcomp(var a,b):longint; far;
var int1: integer absolute a;
    int2: integer absolute b;
begin
  if int1<int2 then intcomp:=-1
  else if int1=int2 then intcomp:=0
  else intcomp:=1;
end;

procedure datamon; far; var i:byte; begin
  inc(sortcount); for i:=1 to cmax do write(data[i]:4); writeln; end;

begin {tstsrt}
  Writeln('Now generating up to ',max,' random numbers...');
  Randomize;
  for i:=1 to max do begin
      b:=random(256);

      { If "b" has already been generated, "lsearch" should find it;
        otherwise "lsearch" should add it to the end. }

      if b in bs then
         if lsearch(b,data,cmax,sizeof(integer),intcomp)>cmax then
            writeln('Error in "lsearch": element not found ',b)
         else
      else if lsearch(b,data,cmax,sizeof(integer),intcomp)<=cmax then
         writeln('Error in "lsearch": invalid element inserted ',b)
      else begin bs:=bs + [b]; inc(cmax) end; end;
  datamon; write(' (Press return)'); readln;

  Writeln('Now sorting ',cmax,' random numbers...');

{$ifdef MONITOR}  { This will let us keep track of the how the sort is
                  progressing }
{ !!! MONITOR must be defined in ASORTS for this to work }
asorts.monitor:=datamon;
data2:=data; {for subsequent comparison}
sortcount:=0;
{$endif}

  qsort(data,cmax,sizeof(integer),intcomp);

{$ifdef MONITOR}
qsc:=sortcount; sortcount:=0;
writeln('Now let''s see how the NaiveSort compares to the QuickSort that');
writeln('   we just finished');
  write(' (Press return)'); readln;

data:=data2;
naivesort(data,cmax,sizeof(integer),intcomp);

writeln('And the score is: QSort:',qsc,', vs NaiveSort:',sortcount, 'swaps');

{ This is not important for this program, but if you call "qsort" from
  multiple locations, what the procedure does might not always make sense.
  So, we turn the monitor off. }

asorts.nullmonitor;

{$else}
  datamon;
{$endif}
  write(' (Press return)'); readln;
  writeln('Now searching for ',cmax,' sorted numbers...');
  for i:=0 to 255 do begin
      { All byte values will be sought.  It would be an error for
        "bsearch" to find a value that was not inserted into the
        array.  Also, to fail to find a value that was inserted
        into the array }
      if bsearch(i,data,cmax,sizeof(integer),intcomp)=0 then
         if i in bs then
            Writeln('Error in "bsearch": element not found ',i)
         else
      else if not (i in bs) then
         writeln('Error in "bsearch": invalid element found ',i)
      else if i<>data[bsearch(i,data,cmax,sizeof(integer),intcomp)] then
         writeln('Error in "bsearch": wrong index returned');

      if fibsearch(i,data,cmax,sizeof(integer),intcomp)=0 then
         if i in bs then
            Writeln('Error in "fibsearch": element not found ',i)
         else
      else if not (i in bs) then
         writeln('Error in "fibsearch": invalid element found ',i)
      else if i<>data[fibsearch(i,data,cmax,sizeof(integer),intcomp)] then
         writeln('Error in "fibsearch": wrong index returned');
      end;
  writeln('....Search complete.');

  { We are now going to exercise the submove and xsubmove procedures
    in ASORTS.  For the simple submove, the first five elements of "data"
    are going to be moved to "pseudo" array that starts at data[9].  The
    target array is presumed to consist of elements that are two integers
    in size.  So, the moved values will wind up in every other integer
    displayed.}
  writeln('Now doing a simple array submove ... (1->9,2->11,...5->17)');
  submove(data[1],data[9],5,2,4);
  datamon; write(' (Press return)'); readln;


  { For the more general "xsubmove", we are going to presume that the
    source array is also two integers per element, but we only want to move
    the first element.  (The source and target are overlayed in this example
    so that what is seen are pairs of numbers appear in "data".) }
  writeln('Now doing a complex array submove ...(1->2,3->4,...9->10)');
  xsubmove(data[1],data[2],5,4,4,2);
  datamon; write(' (Press return)'); readln;

  { Now put 255 into the even slots }
  writeln('Now interlacing "255" into the array');
  b:=255;
  subfill(b,data[2],9,2,4);
  datamon; write(' (Press return)'); readln;

  { Now put 0 everywhere }
  writeln('Now filling array with 0''s...');
  b:=0;
  fill(b,data,19,sizeof(integer));
  datamon; write(' (Press return)'); readln;

  { Now let's tryout the binary insertion procedure }
  writeln('Now creating a new, sorted random array ... ');
  cmax:=0; bs:=[];
  for i:=1 to max do begin
      b:=random(256);
      b:=binsert(b,data,cmax,sizeof(integer),intcomp);
      inc(cmax); end;
  datamon; write(' (Press return)'); readln;

  { Now, let's check out the swab procedure }
  writeln('Now swabbing the array...results should be the same');
  swab(data,data,19); datamon;
  swab(data,data,19); datamon;
  write(' (Press return)'); readln;

  { That only leaves "shuffle" to be exercised, so let's mess up everything
    before we exit. }
  writeln('Now shuffling ',cmax,' numbers...');
  shuffle(data,cmax,sizeof(integer));
  datamon; write(' (Press return)'); readln;

  writeln('Done.');
end.