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 / MTSORT.MZD / MTSORT.MOD
Text File  |  2000-06-30  |  2KB  |  78 lines
  1. MODULE MTSort2;
  2. (* Program will test the speed of sorting an integer array.        *)
  3. (* The program will create an array sorted from smaller to larger  *)
  4. (* integers, then sort them in the reverse order.                  *)
  5. (* The array is reverse sorted ten times.                          *)
  6.  
  7. FROM InOut IMPORT WriteString, WriteLn, WriteCard, Read, Write;
  8.  
  9. CONST SIZE = 1000;
  10.  
  11. TYPE NUMBERS = ARRAY[1..SIZE] OF CARDINAL;
  12.  
  13. VAR InOrder, AscendingOrder : BOOLEAN;
  14.     Iter, Offset, I, J, Temporary : CARDINAL;
  15.     Ch : CHAR;
  16.     A : NUMBERS;
  17.  
  18. PROCEDURE InitializeArray ;
  19. (* Procedure to initialize array *)
  20. BEGIN
  21.     WriteString('Initializing integer array'); WriteLn;
  22.     FOR I := 1 TO SIZE DO
  23.         A[I] := I
  24.     END; (* FOR I *)
  25. END InitializeArray;
  26.  
  27. PROCEDURE ShellSort ;
  28. (* Procedure to perform a Shell-Meztner sorting *)
  29.  
  30.     PROCEDURE SwapThem;
  31.     (* Local procedure to swap elements A[I] and A[J] *)
  32.     BEGIN
  33.        InOrder := FALSE;
  34.        Temporary := A[I];
  35.        A[I] := A[J];
  36.        A[J] := Temporary;
  37.     END SwapThem;
  38.  
  39. BEGIN
  40.    (* Toggle 'AscendingOrder' flag status *)
  41.        AscendingOrder := NOT AscendingOrder;
  42.        Offset := SIZE;
  43.        WHILE Offset > 1 DO
  44.            Offset := Offset DIV 2;
  45.            REPEAT
  46.                InOrder := TRUE;
  47.                FOR J := 1 TO (SIZE - Offset) DO
  48.                    I := J + Offset;
  49.                    IF AscendingOrder 
  50.                        THEN IF A[I] < A[J] THEN SwapThem END
  51.                        ELSE IF A[I] > A[J] THEN SwapThem END
  52.                    END; (* IF AscendingOrder *)
  53.                END; (* FOR J *)
  54.            UNTIL InOrder;
  55.        END; (* End of while-loop *)
  56. END ShellSort;
  57.  
  58. PROCEDURE DisplayArray; 
  59. (* Display array members *)
  60. BEGIN
  61.     FOR I := 1 TO SIZE DO
  62.         WriteCard(A[I],3); 
  63.         WriteString('  ');
  64.     END; (* FOR I *)
  65.     WriteLn;
  66. END DisplayArray;
  67.  
  68. BEGIN (* Main *)
  69.     InitializeArray;
  70.     AscendingOrder := TRUE;
  71.     WriteString('Beginning to sort press <cr>'); Read(Ch); WriteLn;
  72.     FOR Iter := 1 TO 10  DO 
  73.        Write('.');
  74.        ShellSort   
  75.     END; (* FOR Iter  *)
  76.     WriteString('Finished sorting!');
  77.     DisplayArray;
  78. END MTSort2.