PROGRAM TestSorts (Input,Output);

CONST
   MaxSize = 5000;

   m = 100000000;   {random num generator}     
   b = 31415821;
   m1 = 10000;

TYPE
   ArrayType = Array[1..MaxSize] of Integer;
   
VAR
   TestArray, D : ArrayType;
   NumTests, Size, MaxKey : Integer;
   RandNum, QSCount, MergeCount : Integer4;
   Another : Char;
   Again : Boolean;






{Generate a pseudo-random number between 0 and 1.
RandNum should be seeded at start of each program. }

FUNCTION Random : Real;


FUNCTION Mult (p, q :Integer4) : Integer4;
Var 
   p1 , p0, q1, q0 : Integer4;
Begin
   p1 := p DIV m1;
   p0 := p MOD m1;
   q1 := q DIV m1;
   q0 := q MOD m1;
   Mult := (((p0*q1 + p1*q0) MOD m1) * m1 + p0*q0) MOD m;
End;


Begin
   RandNum := (Mult(RandNum,b) + 1) MOD m;
   Random := RandNum / m;
End;



{  Test randomness of random number generator
FUNCTION Chisquare (N : Integer) : Real;
Const
   Rmax = 100;
Var
   i, j, t : Integer;
   f : Array[0..Rmax] of Integer;
   A : ArrayType; 
Begin
   Writeln('Seed');
   Readln(RandNum);
   FOR i := 0 to Rmax DO
      f[i] := 0;

   FOR i := 1 to N DO
    Begin
     t := Trunc (Random * Rmax);
     f[t] := f[t] + 1;
     A[i] := t;
    End;

   i := 1;
   REPEAT
      FOR j := 0 to 4 DO
         Write(A[i+j]);
      Writeln;
      i := i + 5;
   UNTIL i >= N;

   t := 0;
   FOR i := 0 to Rmax-1 DO
      t := t + f[i]*f[i];
   Chisquare := (Rmax*t / N) - N;
End;   
}



PROCEDURE SelectionSort (Var A : ArrayType;
                         Size : Integer;
                         Var Count : Integer4);
Var
   i, j, max, m, temp : Integer;
Begin
   count := 0;
   FOR j := Size Downto 2 DO
    Begin
      i := 1;
      max := A[1];
      FOR M := 2 TO j DO
        Begin
         count := count + 1;
         IF A[m] > max THEN
          Begin
            max := A[m];
            i := m;
          End;
        End;
      temp := A[j];    {Swap a[j],A[i]}
      A[j] := A[i];
      A[i] := temp;
    End;
  { Writeln('Selection sort: ',count);}

{   i := 1;
   REPEAT
      FOR j := 0 to 4 DO
         Write(A[i+j]);
      Writeln;
      i := i + 5;
   UNTIL i >= Size;  }
End;




PROCEDURE InsertionSort (Var A : ArrayType;
                          Size : Integer;
                          Var Count : Integer4);  
Var
   m, i, temp, j : Integer;
Begin
 
{    i := 1;    
    REPEAT  
      FOR j := 0 TO 4 DO
         Write(A[i+j]);
      Writeln;
      i := i + 5;
    UNTIL i >= Size; }
  
   count := 0;
   FOR m := 2 TO Size DO
    Begin
     temp := A[m];
     i := 1;
     WHILE (A[i] <= A[m]) AND (i < m) DO
      Begin
        count := count + 1;
        i := i + 1;
      End;
     FOR j := m-1 DOWNTO i DO
        A[j+1] := A[j];
     A[i] := temp;
    End;
 
   { Writeln('Insertion sort : ',count);}
 
  {  i := 1;    
    REPEAT  
      FOR j := 0 TO 4 DO
         Write(A[i+j]);
      Writeln;
      i := i + 5;
    UNTIL i >= Size;} 
End;



PROCEDURE BubbleSort (Var A : ArrayType;
                       Size : Integer;
                       Var Count : Integer4);
Var
   i, j, temp : Integer;
   exchange : Boolean;
Begin
   count := 0;
   i := Size;
   exchange := True;
   WHILE (i >= 1) AND exchange DO
    Begin
      exchange := False;
      FOR j := 2 TO i DO
        Begin
         count := count + 1;
         IF A[j-1] > A[j] THEN
          Begin
            temp := A[j-1];
            A[j-1] := A[j];
            A[j] := temp;
            exchange := True;
          End;
        End;
      i := i - 1;
    End;

{   Writeln('Bubble sort: ',count);}

 {  i := 1;
   REPEAT
      FOR j := 0 TO 4 DO
         Write(A[i+j]);
      Writeln;
      i := i + 5;
   UNTIL i >= Size;  }
End;



PROCEDURE QuickSort (Var A : ArrayType;
                     left, right : Integer);
Var
   p, i, j, temp : Integer;
Begin
   IF left < right THEN
    Begin
     p := left;
     i := left + 1;
     j := right;
     REPEAT
       WHILE (A[i] <= A[p]) AND (i <= j) DO
        Begin
          QSCount := QSCount + 1;
          i := i + 1;
        End;
       WHILE (A[j] > A[p]) AND (i <= j) DO
        Begin
          QSCount := QSCount + 1;  
          j := j - 1;
        End;
       IF i < j THEN
        Begin
         temp := A[i];
         A[i] := A[j];
         A[j] := temp;
         i := i + 1;
         j := j - 1;
        End;
     UNTIL j < i;
     temp := A[j];
     A[j] := A[p];
     A[p] := temp;
     p := j;
     QuickSort(A,left,p-1);
     QuickSort(A,p+1,right);
    End;

End;







PROCEDURE Merge (Var A : ArrayType;  
                 Left1, Right1, Right2 : Integer);
                 
VAR
   i,j,k,l : Integer;

Begin
   i := Left1;
   j := Right1 + 1;
   k := 1;      {Index into merge array}

   WHILE (i <= Right1) AND (j <= Right2) DO
     Begin
       MergeCount := MergeCount + 1;
       IF A[i] <= A[j] THEN
         Begin
           D[k] := A[i];
           i := i + 1;
         End
       ELSE
         Begin
           D[k] := A[j];
           j := j + 1;
         End;
       k := k + 1;
     End;

   IF i > Right1 THEN
     WHILE j <= Right2 DO
       Begin
         D[k] := A[j];
         j := j + 1;
         k := k + 1;
       End
   ELSE
     WHILE i <= Right1 DO
       Begin
         D[k] := A[i];
         i := i + 1;
         k := k + 1;
       End;

   FOR l := 1 to k-1 DO     {Copy back to A}
      A[Left1+l-1] := D[l];

 
End;
     



PROCEDURE MERGESORT (Var A : ArrayType;
                     Left, Right : Integer);
Var
   mid : Integer;

Begin
   If Left <> Right Then
     Begin
       mid := (Left + Right) DIV 2;
       MergeSort(A,Left,mid);
       MergeSort(A,mid+1,Right);
       Merge(A,Left,mid,Right);
     End;
End;






PROCEDURE FillArray (VAR TestArray : ArrayType;
                     Size, MaxKey : Integer);
Var
   i, j : Integer;
 
Begin
   FOR i := 1 to Size DO
    Begin
      TestArray[i] := Trunc(Random * MaxKey);
     { Writeln(TestArray[i]);}
    End;

 {  i := 1;
   REPEAT
       FOR j := 0 TO 4 DO
         Write(TestArray[i+j]);
       Writeln;
       i := i + 5;
    UNTIL i >= Size;}
End;






PROCEDURE Test (Size, MaxKey, NumTests : Integer);
Var 
   i, j, k : Integer;
   Comparisons, Count : Integer4;

Begin
   Comparisons := 0;
   Writeln('Array size is ',
                Size:-1,' elements. ');
   Writeln('Key range is 1-',MaxKey:-1);

   FOR i := 1 to NumTests DO
    Begin
      FillArray(TestArray,Size,MaxKey);
      SelectionSort(TestArray,Size,Count);
      Comparisons := Comparisons + Count;
    End;
   Writeln('Selection sort average comps= ',
           Comparisons/NumTests:10:0);
   Comparisons := 0;

   FOR i := 1 to NumTests DO
    Begin
      FillArray(TestArray,Size,MaxKey);
      InsertionSort(TestArray,Size,Count);
      Comparisons := Comparisons + Count;
    End;
   Writeln('Insertion sort average comps= ',
           Comparisons/NumTests:10:0);
   Comparisons := 0;

   FOR i := 1 to NumTests DO
    Begin
      FillArray(TestArray,Size,MaxKey);
      BubbleSort(TestArray,Size,Count);
      Comparisons := Comparisons + Count;
   End;
   Writeln('Bubble sort average comps=    ',
           Comparisons/NumTests:10:0);
   Comparisons := 0;
   

   FOR i := 1 to NumTests DO
    Begin
      FillArray(TestArray,Size,MaxKey);
      QSCount := 0;
      QuickSort(TestArray,1,Size);
      Comparisons := Comparisons + QSCount;
     { Writeln('QiuckSort count = ',QSCount);}
     { k := 1;
      REPEAT
         FOR j := 0 TO 4 DO
            Write(TestArray[k+j]);
         Writeln;
         k := k + 5;
      UNTIL k >= Size;}  
    End;
   Writeln('Quick sort average comps=     ',
           Comparisons/NumTests:10:0);
   Comparisons := 0;


   FOR i := 1 to NumTests DO
    Begin
      MergeCount := 0;
      FillArray(TestArray,Size,MaxKey);
      MergeSort(TestArray,1,Size);
      Comparisons := Comparisons + MergeCount;
    End;
   Writeln('Merge sort average comps=     ',
           Comparisons/NumTests:10:0);


End;


   
BEGIN
{   Writeln(Chisquare(N)); }

   Writeln('Seed random number generator');
   Readln(RandNum);

   Again := True;
   Repeat
      Writeln('Array size?');
      Readln(Size);
      Writeln('Key range?');
      Readln(MaxKey);
      Writeln('Number of tests?');
      Readln(NumTests);
      Test(Size,MaxKey,NumTests);
      Writeln;
      Writeln('Another?');
      Readln(Another);
      If (Another <> 'Y') AND (Another <> 'y') Then
         Again := False;
   Until Not Again;

END.