home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol024 / shell.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  3KB  |  119 lines
  1. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {+  PROGRAM TITLE:    Shell Sort Test            +}
  3. {+                            +}
  4. {+  WRITTEN BY:        Raymond E. Penley        +}
  5. {+  DATE WRITTEN:    5 October 1980            +}
  6. {+                            +}
  7. {+  SUMMARY:                        +}
  8. {+    This program demonstrates the Shell sort    +}
  9. {+    algorithm.                    +}
  10. {+                            +}
  11. {+       Average sorting times in seconds *        +}
  12. {+  No. of items   Shellsort    Quicksort  QQuicksort   +}
  13. {+     1000         15             8          7    +}
  14. {+     2000         34            20         14        +}
  15. {+     5000        112            50         37        +}
  16. {+   10,000        213           106         78        +}
  17. {+                            +}
  18. {+    * Z80 CPU operating at 2 mcps            +}
  19. {+                            +}
  20. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  21. PROGRAM Shellsorttest;
  22. CONST
  23.   Max_N = 10000;
  24. TYPE
  25.   INDEX = 0..Max_N;
  26.   SCALAR = INTEGER;
  27.   ScalarTyp = ARRAY [ INDEX ]  OF SCALAR;
  28. VAR
  29.   cix : char;        {Global temp for char inputs}
  30.   A   : ScalarTyp;
  31.   N,            {The number of numbers to be sorted.}
  32.   i, ix : INTEGER;    {Global indexer}
  33.  
  34. Procedure Show;
  35. var
  36.   i: index;
  37. begin
  38.   for i:=1 to N do
  39.     begin
  40.       write(A[i]);
  41.       if i mod 8 = 0 then writeln;
  42.     end;
  43.   writeln;
  44. end;
  45.  
  46.  
  47.  
  48.  
  49. PROCEDURE Shellsort(VAR A : ScalarTyp;
  50.             n : INDEX);
  51. {
  52. The array A[1..n] is sorted in ascending order. The method is that
  53. of D.A. Shell, (A high-speed sorting procedure, Comm. ACM 2 (1959),
  54. 30-32) with subsequences chosen as suggested by T.N. Hibberd.
  55. }
  56. VAR
  57.   i, j, k, m    : integer;
  58.   done         : BOOLEAN;
  59.   temp        : SCALAR;
  60. begin (*$C-,M-,F-*)
  61.   m := n;
  62.   While m <> 0 do
  63.     begin
  64.       m := m DIV 2;
  65.       k := n - m;
  66.       for j:=1 to k do
  67.     begin
  68.       i := j;
  69.       done := FALSE;
  70.       repeat
  71.         if A[i+m] >= A[i] then
  72.           done := TRUE
  73.         else
  74.           begin
  75.         temp := A[i]; A[i] := A[i+m]; A[i+m] := temp;
  76.         i := i - m;
  77.           end;
  78.       until (i<1) OR ( done );
  79.     end{for j};
  80.     end{While};
  81. end;{Shellsort}{$C+,M+,F+}
  82.  
  83.  
  84.  
  85. BEGIN (* Main program SHELLSORT*)
  86.   Repeat
  87.     writeln;
  88.     writeln('Enter number of items to sort');
  89.     writeln(' 10 <= n <= 10,000');
  90.     write('?');
  91.     readln(N);
  92.   Until (N >= 10) and (N <= Max_N);
  93.   writeln;
  94.   writeln('Please stand by while I set up.');
  95.   ix := 113;                {$C-,M-,F- [ctrl-c OFF]}
  96.   FOR i := 1 TO N DO
  97.     BEGIN
  98.       ix := (131*ix+1) mod 221;
  99.       A[i] := ix;
  100.       if (i mod 1000 = 0) then write(i);
  101.     END;
  102.   writeln;
  103.   A[0] := -maxint;            {$C+,M+,F+ [ctrl-c ON]}
  104.  
  105.   writeln('Ready');
  106.   WRITE('Press return when ready to start');
  107.   readln(cix);
  108.   writeln( CHR(7), 'START');
  109.   {}
  110.       Shellsort(A, N );
  111.   {}
  112.   WRITELN( CHR(7), 'DONE!!!' );
  113.  
  114.   writeln;
  115.   write('Print the array (Y/N)?');
  116.   readln(cix);
  117.   If (cix='Y') or (cix='y') then Show;
  118. END.
  119.