
PROGRAM MergeSort (Input,Output);

CONST
   MaxSize = 2000;

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

TYPE
   ArrayType = Array[1..MaxSize] of Integer;
   
VAR
   A : ArrayType;
   NumTests, Size, MaxKey, k, j : Integer;
   RandNum, Count, TotalCount : 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;









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 Merge (Var A : ArrayType;  
                 Left1, Right1, Right2 : Integer);
                 
VAR
   i,j,k,l : Integer;
   D : ArrayType;

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

   WHILE (i <= Right1) AND (j <= Right2) DO
     Begin
       Count := Count + 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;





   
BEGIN

   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);
      TotalCount := 0;
      For j := 1 to NumTests Do
        Begin
          Count := 0;  
          FillArray(A,Size,MaxKey);
          MergeSort(A,1,Size);
          TotalCount := TotalCount + Count;
        End;
      Writeln('Average comparisons is ',                 
TotalCount/NumTests:9:1);
      Writeln;
      Writeln('Another?');
      Readln(Another);
      If (Another <> 'Y') AND (Another <> 'y') Then
         Again := False;
   Until Not Again;




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