Category : Pascal Source Code
Archive   : ASORTS.ZIP
Filename : TSTSRT.PAS

 
Output of file : TSTSRT.PAS contained in archive : ASORTS.ZIP

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 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.