home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / languags / modula2 / sort.mod < prev    next >
Text File  |  1987-01-08  |  4KB  |  201 lines
  1. (* This program initializes an array and performs
  2.    various different sorts. *)
  3.  
  4. MODULE Sort;
  5. FROM InOut IMPORT Write,WriteLn,WriteCard,WriteInt,Read,WriteString;
  6.  
  7.  
  8. CONST n= 256;
  9.       nn=512;
  10.  
  11. TYPE index =[0..nn];
  12.      item = RECORD
  13.               key : INTEGER;
  14.             END;
  15. VAR i : index;
  16.     r : INTEGER;
  17.     a : ARRAY [-15..nn] OF item;
  18.     z : ARRAY [1..n] OF INTEGER;
  19.     Ch: CHAR;
  20.  
  21. PROCEDURE BubbleSort;
  22. VAR i,j : index;
  23.     x : item;
  24.  
  25. BEGIN
  26.   FOR i := 2 TO n DO
  27.     FOR j := n TO i BY -1 DO
  28.       IF a[j-1].key > a[j].key THEN
  29.         x := a[j-1];
  30.         a[j-1] := a[j];
  31.         a[j] := x;
  32.       END
  33.     END
  34.   END
  35. END BubbleSort;
  36.  
  37. PROCEDURE Bubblex;
  38. VAR j,k,l : index;
  39.     x : item;
  40.  
  41. BEGIN
  42.   l := 2;
  43.   REPEAT
  44.     k := n;
  45.     FOR j := n TO l BY -1 DO
  46.       IF a[j-1].key > a[j].key THEN
  47.         x := a[j-1]; a[j-1] := a[j]; a[j] := x;
  48.         k := j
  49.       END
  50.     END;
  51.   l := k + 1;
  52.   UNTIL l > n
  53. END Bubblex;
  54.  
  55. PROCEDURE ShakerSort;
  56. VAR j,k,l,r : index;
  57.     x : item;
  58.  
  59. BEGIN
  60.   l := 2; r := n; k := n;
  61.   REPEAT
  62.     FOR j := n TO l BY -1 DO
  63.       IF a[j-1].key > a[j].key THEN
  64.         x := a[j-1];
  65.         a[j-1] := a[j];
  66.         a[j] := x;
  67.         k :=j
  68.       END
  69.     END;
  70.     l := k + 1;
  71.     FOR j := l TO r DO
  72.       IF a[j-1].key > a[j].key THEN
  73.         x := a[j-1];
  74.         a[j-1] := a[j];
  75.         a[j] := x;
  76.         k :=j
  77.       END
  78.     END;
  79.     r := k - 1;
  80.   UNTIL l > r
  81. END ShakerSort;
  82.  
  83. PROCEDURE QuickSort;
  84.  
  85.   PROCEDURE sort(l,r:index);
  86.   VAR i,j : index;
  87.       x,w : item;
  88.   BEGIN
  89.     i := l; j :=r;
  90.     x := a[(l + r) DIV 2];
  91.     REPEAT
  92.       WHILE a[i].key < x.key DO INC(i) END;
  93.       WHILE x.key < a[j].key DO DEC(j) END;
  94.       IF i <= j THEN
  95.         w := a[i];
  96.         a[i] := a[j];
  97.         a[j] := w;
  98.         INC(i);
  99.         DEC(j);
  100.       END;
  101.     UNTIL i > j;
  102.     IF l < j THEN sort(l,j) END;
  103.     IF i < r THEN sort(i,r) END;
  104.   END sort;
  105. BEGIN
  106.   sort(1,n)
  107. END QuickSort;
  108.  
  109. PROCEDURE QuickSort1;
  110. CONST m = 12;
  111. TYPE  ss = [0..m];
  112. VAR i,j,l,r : index;
  113.     x,w : item;
  114.     s : ss;
  115.     stack : ARRAY [1..m] OF RECORD l,r : index END;
  116. BEGIN
  117.   s := 1; stack[1].l := 1; stack[1].r := n;
  118.   REPEAT
  119.     l := stack[s].l; r := stack[s].r; DEC(s);
  120.     REPEAT
  121.       i := l; j := r; x := a[(l + r) DIV 2]; 
  122.       REPEAT
  123.         WHILE a[i].key < x.key DO INC(i) END;
  124.         WHILE x.key < a[j].key DO DEC(j) END;
  125.         IF i <= j THEN
  126.           w := a[i]; a[i] := a[j]; a[j] := w;
  127.           INC(i);DEC(j);
  128.         END;
  129.       UNTIL i > j;
  130.       IF i < r THEN
  131.         INC(s); stack[s].l := i; stack[s].r := r;
  132.       END;
  133.       r := j
  134.     UNTIL l >=r
  135.   UNTIL s = 0
  136. END QuickSort1;
  137.  
  138. BEGIN (*Main*)
  139.   i := 0;
  140.   r :=54;
  141.   REPEAT
  142.     INC(i);
  143.     r := (8 * r) MOD 2141;
  144.     z[i] :=r;
  145.   UNTIL i = n;
  146.   FOR i := 1 TO n DO 
  147.     a[i].key := z[i];
  148.   END;
  149.   BubbleSort;
  150.   FOR i := 1 TO n DO 
  151.     WriteString("Changed BubbleSort-> ");
  152.     WriteInt(a[i].key,3);
  153.     WriteLn;
  154.   END;
  155.   WriteLn;
  156.   Read(Ch);
  157.   FOR i := 1 TO n DO 
  158.     a[i].key := z[i];
  159.   END;
  160.   QuickSort;
  161.   FOR i := 1 TO n DO 
  162.     WriteString("Changed QuickSort-> ");
  163.     WriteInt(a[i].key,3);
  164.     WriteLn;
  165.   END;
  166.   WriteLn;
  167.   Read(Ch);
  168.   FOR i := 1 TO n DO 
  169.     a[i].key := z[i];
  170.   END;
  171.   QuickSort1;
  172.   FOR i := 1 TO n DO 
  173.     WriteString("Changed QuickSort1-> ");
  174.     WriteInt(a[i].key,3);
  175.     WriteLn;
  176.   END;
  177.   WriteLn;
  178.   Read(Ch);
  179.   FOR i := 1 TO n DO 
  180.     a[i].key := z[i];
  181.   END;
  182.   Bubblex;
  183.   FOR i := 1 TO n DO 
  184.     WriteString("Changed Bubblex-> ");
  185.     WriteInt(a[i].key,3);
  186.     WriteLn;
  187.   END;
  188.   WriteLn;
  189.   Read(Ch);
  190.   FOR i := 1 TO n DO 
  191.     a[i].key := z[i];
  192.   END;
  193.   ShakerSort;
  194.   FOR i := 1 TO n DO 
  195.     WriteString("Changed ShakerSort-> ");
  196.     WriteInt(a[i].key,3);
  197.     WriteLn;
  198.   END;
  199.   WriteLn;
  200. END Sort.
  201.