program cmpsrt;
{ Compares various sorting algorithms on random arrays }

{   -- as distributed, 100 random arrays of 100 integers are
       generated and sorted against 6 different sorting methods.
       When completed, the program reports the total number
       of comparisons and exchanges that each method used.  }

{ assumes "MONITOR" defined in ASORTS.TPU }

{ NOTE: This program will not compile correctly with ASORTS.PAS
  as you find it in the distribution package. ASORTS.PAS must be
  compiled with the symbol "MONITOR" defined at compilation time.
  There are several ways to do this:

  1. Edit ASORTS.PAS, removing the space between the left brace
and the dollar sign in the "$define MONITOR" compiler directive.
Then recompile the unit to a TPU.

  2. Load the ASORTS.PAS in the IDE. Under Options/Compiler,
define the Conditional symbol "MONITOR". Then Compile/Build the
TPU.

  3. With the command line compiler, TPC, include a "/DMONITOR"
option on the command line.

While the MONITOR symbol is essential to compiling this
demonstration program, you probably will not wish to incur the
additional overhead when using ASORTS for your production
programs. The original ASORTS.PAS, without the MONITOR symbol
defined, is already configured to sort without external
monitoring. }

uses asorts;

const
  max = 100; { <-- change this to compare effect of array length }

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

var
  data,data2: ^list;
  i,j: word;

const
  numsorts = 6;
  sortnames: array [1..numsorts] of string[9] = (
      'HeapSort','QSort','SelSort','ShellSort',
      'VQSort','VSelSort');
 

var
  currentsort:word;
  compcount:array [1..numsorts] of longint;
  swapcount:array [1..numsorts] of longint;

function longintcomp(var a,b):longint; far;
var int1: longint absolute a;
    int2: longint absolute b;
begin
  inc(compcount[currentsort]);
  if int1<int2 then longintcomp:=-1
  else if int1=int2 then longintcomp:=0
  else longintcomp:=1;
end;

procedure swapcounter; far;
begin
  inc(swapcount[currentsort])
end;

function icompdata(a,b:longint):longint; far;
begin
   inc(compcount[currentsort]);
   if data^[a]<data^[b] then icompdata:=-1
   else if data^[a]=data^[b] then icompdata:=0
   else icompdata:=1;
end;

procedure iswapdata(a,b:longint); far;
var c:longint;
begin
   inc(swapcount[currentsort]);
   c:=data^[a]; data^[a]:=data^[b]; data^[b]:=c
end;

procedure checksort;
var i:word;
begin
  for i:=max downto 2 do
      if data^[i]<data^[i-1] then begin
         writeln;
         writeln('Sort algorithm ',sortnames[currentsort],' failed!');
         exit;
      end;
end;
 

begin {tstsrt2}
  asorts.monitor:=swapcounter; { "MONITOR" must be defined in ASORTS.PAS }
  new(data);
  new(data2);
  for i:=1 to numsorts do begin
      compcount[i]:=0; swapcount[i]:=0;
  end;
  Randomize;

  writeln;
  for j:= 1 to 100 do begin
    write(#13,j,'':15);

  { this could be changed to compare the effect of different
    "pre-orderings" on the sorting algorithms.  I'm not sure
    what substitute you could make -- "almost sorted" arrays
    are harder to generate than "random" arrays. }

  for i:=1 to max do begin
      data2^[i]:=longint(random($7fff))-$3fff;
   end;

  for currentsort:=1 to numsorts do begin
      write(#13,j,sortnames[currentsort]:10,'':9);
      data^:=data2^;
      case currentsort of
           1: heapsort(data^,max,sizeof(longint),longintcomp);
           2: qsort(data^,max,sizeof(longint),longintcomp);
           3: selsort(data^,max,sizeof(longint),longintcomp);
           4: shellsort(data^,max,sizeof(longint),longintcomp);
           5: vqsort(max,icompdata,iswapdata);
           6: vselsort(max,icompdata,iswapdata);
       end;
       checksort;
    end;
  end;

writeln(#13,'':25);
writeln('Sort Method':15,'Comparisons':15,'Exchanges':15);
for currentsort:=1 to numsorts do begin
    write(sortnames[currentsort]:15,
          compcount[currentsort]:15);
    if currentsort in [1,4] then
       { for heap and shell, count three moves as a swap }
       writeln((swapcount[currentsort] div 3):15)
    else
       writeln(swapcount[currentsort]:15); end; end.