home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / MODULA2 / MTMOD2.LBR / MTQSOR.MZD / MTQSOR.MOD
Text File  |  2000-06-30  |  2KB  |  76 lines
  1. MODULE QSort2;
  2.  
  3. (* The test uses QuickSort to measure recursion speed *)
  4. (* An ordered array is created by the program and is  *)
  5. (* reverse sorted.  The process is performed 'MAXITER'*)
  6. (* number of times.                                   *)
  7.  
  8. FROM InOut IMPORT WriteString, WriteLn, WriteCard, Write;
  9.  
  10. CONST SIZE = 1000;
  11.       MAXITER = 10;
  12.       WantToListArray = FALSE; (* Flag used for debugging *)
  13.  
  14. TYPE NUMBERS = ARRAY[1..SIZE] OF CARDINAL;
  15.  
  16. VAR Iter, Offset, I, J, Temporary : CARDINAL;
  17.     A : NUMBERS;
  18.  
  19. PROCEDURE InitializeArray ;
  20. (* Procedure to initialize array *)
  21.  
  22. VAR I : CARDINAL;
  23.  
  24. BEGIN
  25.     FOR I := 1 TO SIZE DO
  26.         A[I] := SIZE - I + 1
  27.     END; (* FOR I *)
  28. END InitializeArray;
  29.  
  30. PROCEDURE QuickSort;
  31. (* Procedure to perform a QuickSort *)
  32.  
  33. PROCEDURE Sort(Left, Right : CARDINAL);
  34.  
  35. VAR i, j : CARDINAL;
  36.     Data1, Data2 : CARDINAL;
  37.  
  38. BEGIN
  39.     i := Left; j := Right;
  40.     Data1 := A[(Left + Right) DIV 2];
  41.     REPEAT
  42.         WHILE A[i] < Data1 DO INC(i) END;
  43.         WHILE Data1 < A[j] DO DEC(j) END;
  44.         IF i <= j THEN 
  45.             Data2 := A[i]; A[i] := A[j]; A[j] := Data2;
  46.             INC(i); DEC(j)
  47.         END;
  48.     UNTIL i > j;
  49.     IF Left < j  THEN Sort(Left,j)  END;
  50.     IF i < Right THEN Sort(i,Right) END;
  51. END Sort;
  52.  
  53. BEGIN (* QuickSort *)
  54.     Sort(1,SIZE);
  55. END QuickSort;
  56.  
  57. PROCEDURE DisplayArray; 
  58. (* Display array members *)
  59. BEGIN
  60.     FOR I := 1 TO SIZE DO
  61.         WriteCard(A[I],3); 
  62.         WriteString('  ');
  63.     END; (* FOR I *)
  64.     WriteLn;
  65. END DisplayArray;
  66.  
  67. BEGIN (* Main *)
  68.     FOR Iter := 1 TO MAXITER  DO 
  69.        InitializeArray;    
  70.        Write('.');
  71.        QuickSort   
  72.     END; (* FOR Iter  *)
  73.     WriteLn;
  74.     WriteString('Finished sorting!');
  75.     IF WantToListArray THEN DisplayArray END;
  76. END QSort2.