home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / sigmv024.ark / QSORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.7 KB  |  114 lines
  1. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {+  PROGRAM TITLE:    Quicksort Test            +}
  3. {+                            +}
  4. {+  WRITTEN BY:        Raymond E. Penley        +}
  5. {+  DATE WRITTEN:    October 6, 1980            +}
  6. {+                            +}
  7. {+  Show use of the quicksort algorithm in a Pascal    +}
  8. {+  program.                        +}
  9. {+                            +}
  10. {+       Average sorting times in seconds *        +}
  11. {+  No. of items   Shellsort    Quicksort  QQuicksort   +}
  12. {+     1000         15             8          7    +}
  13. {+     2000         34            20         14        +}
  14. {+     5000        112            50         37        +}
  15. {+   10,000        213           106         78        +}
  16. {+                            +}
  17. {+    * Z80 CPU operating at 2 mcps            +}
  18. {+                            +}
  19. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  20. PROGRAM Qsorttest;
  21. CONST
  22.   Max_N = 10000;        {Upper limit of all numbers}
  23. TYPE
  24.   index = 0..Max_N;
  25.   Scalar = INTEGER;
  26. VAR
  27.   cix    : char;            {Global temp char variable}
  28.   N,                {The number of numbers to be sorted}
  29.   i, ix    : Scalar;        {Global indexers}
  30.   A    : ARRAY [index] OF Scalar; {THE array to be sorted}
  31.  
  32. Procedure Show;
  33. var
  34.   i: index;
  35. begin
  36.   for i:=1 to N do
  37.     begin
  38.       write(A[i]);
  39.       if i mod 8 = 0 then writeln;
  40.     end;
  41.   writeln;
  42. end;
  43.  
  44.  
  45.  
  46.  
  47. PROCEDURE QSORT( left,right: INTEGER );
  48. {    The classic Quicksort method by C.A.R Hoare.
  49.     Presented here in Pascal.        }
  50. {
  51. GLOBAL
  52.   TYPE
  53.     Index  = 1..N;
  54.     Scalar = <Some scalar type>
  55.   VAR
  56.     A : array [Index] of Scalar;
  57. }
  58. VAR
  59.   II, JJ : integer;
  60.   Pivot, temp : Scalar;
  61. BEGIN                 {$C-,M-,F-}
  62.   II := left;
  63.   JJ := right;
  64.   Pivot := A[(II+JJ) DIV 2];
  65.   REPEAT
  66.     WHILE A[II] < Pivot DO II := II + 1;
  67.     WHILE A[JJ] > Pivot DO JJ := JJ - 1;
  68.     IF II <= JJ THEN 
  69.       BEGIN
  70.     temp := A[II]; A[II] := A[JJ]; A[JJ] := temp;
  71.     II := II + 1;
  72.     JJ := JJ - 1
  73.       END
  74.   UNTIL II > JJ;
  75.   IF left < JJ THEN QSORT( left, JJ );
  76.   IF II < right THEN QSORT( II, right )
  77. END;{of QSORT}            {$C+,M+,F+}
  78.  
  79. BEGIN (* MAIN *)
  80.   repeat
  81.     writeln;
  82.     writeln('Enter number of items to sort');
  83.     writeln(' 10 <= n <= 10,000');
  84.     write('?');
  85.     readln(N);
  86.   until (N >= 10) and (N <= Max_N);
  87.  
  88.   writeln;
  89.   writeln('Please stand by while I set up.');
  90.   ix := 113;                {$C-,M-,F- [ctrl-c OFF]}
  91.   FOR i := 1 TO N DO
  92.     BEGIN
  93.       ix := (131*ix+1) mod 221;
  94.       A[i] := ix;
  95.       if (i mod 1000 = 0) then write(i);
  96.     END;
  97.   writeln;
  98.   A[0] := -maxint;            {$C+,M+,F+ [ctrl-c ON]}
  99.  
  100.   writeln('Ready');
  101.   WRITE('Press return when ready to start');
  102.   readln(cix);
  103.   writeln( CHR(7), 'START');
  104.   {}
  105.       QSORT( 1, N );
  106.   {}
  107.   WRITELN( CHR(7), 'DONE!!!' );
  108.  
  109.   writeln;
  110.   write('Print the array (Y/N)?');
  111.   readln(cix);
  112.   If (cix='Y') or (cix='y') then Show;
  113. END.
  114.