home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / txtutl / sortdemo.arc / QUICK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-03  |  4.4 KB  |  146 lines
  1.                                            { K.L. Noell, fhw  09/01/87 }
  2.   Program QuickSort_Demo (output);
  3.  
  4.   Const n = 639;            { number of columns :  x-coordinates }
  5.         range = 199;        { actual size :        y-coordinates }
  6.         clear_pixel = 0;
  7.         set_pixel   = 3;
  8.   VAR
  9.         k: INTEGER;
  10.         num,loops,swaps,aloops,aswaps: REAL;
  11.         A : ARRAY [1..n] OF INTEGER;
  12.  
  13.  
  14.   PROCEDURE Swap ( VAR x,y:INTEGER );
  15.   VAR
  16.         temp: INTEGER;
  17.  
  18.   BEGIN
  19.         temp := x;
  20.         x := y;
  21.         y := temp;
  22.         swaps := swaps + 1;
  23.   END;  { Swap }
  24.  
  25.  
  26.   FUNCTION FindPivot (i,j:INTEGER): INTEGER;
  27.      { returns 0 if A[i], ... , A[j] have identical keys; otherwise
  28.        returns the index of the larger of the leftmost 2 different keys }
  29.  
  30.   VAR
  31.        firstkey: INTEGER; { value of the first key found, i.e. A[i] }
  32.        k: INTEGER;        { runs left to right, looking for a diff. key }
  33.  
  34.   BEGIN
  35.        firstkey := A[i];
  36.        FindPivot := 0;                    { never found different keys }
  37.        FOR k := i+1 TO j DO               { scan for different key     }
  38.            IF A[k] > firstkey THEN        { select larger key          }
  39.               FindPivot := k              { return (k)                 }
  40.            ELSE IF A[k] < firstkey THEN
  41.               FindPivot := i;             { return (i)                 }
  42.   END;  { FindPivot }
  43.  
  44.  
  45.   FUNCTION Partition (i,j,pivot: INTEGER): INTEGER;
  46.     { partitions A[i], ... ,A[j] so keys < pivot are at the left
  47.       and keys >= pivot are on the right.  Returns the beginning
  48.       of the group on the right. }
  49.  
  50.   VAR
  51.        l,r: INTEGER;            { cursors as described above }
  52.  
  53.   BEGIN
  54.        l := i;
  55.        r := j;
  56.  
  57.        REPEAT
  58.             Plot (l,a[l],clear_pixel);
  59.             Plot (r,A[r],clear_pixel);
  60.             Swap (A[l],A[r]);
  61.             Plot (l,A[l],set_pixel);
  62.             Plot (r,A[r],set_pixel);
  63.  
  64.        { now the scan phase begins }
  65.             WHILE A[l] <  pivot DO
  66.                   l := l + 1;
  67.             WHILE A[r] >= pivot DO
  68.                   r := r - 1;
  69.         UNTIL  l > r;
  70.  
  71.         Partition := l
  72.   END;  { Partition }
  73.  
  74.  
  75.   PROCEDURE QuickSort (i,j: INTEGER);
  76.     { sort elements A[i], ... ,A[j] of external array A }
  77.  
  78.    VAR
  79.        pivot: INTEGER;       { the pivot value }
  80.        pivotindex: INTEGER;  { the index of an element of A where
  81.                                key is the pivot }
  82.        k: INTEGER;           { beginning index for group of elements >= piv }
  83.  
  84.   BEGIN
  85.        loops := loops + 1;
  86.        pivotindex := FindPivot (i,j);
  87.        IF pivotindex <> 0 THEN BEGIN   { do nothing if all keys are equal }
  88.           pivot := A[pivotindex];
  89.           k := Partition (i,j,pivot);
  90.           Quicksort (i,k-1);           { recursive call                   }
  91.           QuickSort (k,j);             { recursive call                   }
  92.        END
  93.   END;  { QuickSort }
  94.  
  95.  
  96.  BEGIN  (************  Mainrogram  quickSort_Demo ******************)
  97.  
  98.       HiRes;
  99.       HiResColor (Magenta);
  100.  
  101.       FOR k:=1 TO n DO BEGIN           { generating and sorting           }
  102.           num := range*RANDOM;         { random numbers                   }
  103.           A [k] := TRUNC (num);
  104.           Plot (k,A[k],set_pixel);
  105.       END;
  106.  
  107.       GraphBackground (Magenta);
  108.       Palette (2);
  109.  
  110.     {Sorting start:}
  111.       loops := 0;
  112.       swaps := 0;
  113.  
  114.       DELAY (1000);
  115.  
  116.       QuickSort (1,n);
  117.       aloops := loops;
  118.       aswaps := swaps;
  119.       Writeln ('    Quick Sort a)  Loops,Swaps: ',loops,swaps);
  120.       Writeln;
  121.       Writeln ('b)  Press any key to process with an array already sorted,');
  122.       Writeln ('    but in opposite direction.');
  123.  
  124.       REPEAT UNTIL KeyPressed;
  125.  
  126.       Hires;
  127.  
  128.       FOR k:=1 TO n DO BEGIN           { generating and sorting an array  }
  129.           num := (n-k)/(n/range);      { already sorted, but in opposite  }
  130.           A [k] := TRUNC (num);        { direction.                       }
  131.           PLOT (k,A[k],set_pixel);
  132.       END;
  133.  
  134.       DELAY (1000);
  135.  
  136.       QuickSort (1,n);
  137.       Writeln ('    Quick Sort a)  Loops,Swaps: ',aloops,aswaps);
  138.       Writeln ('    Quick Sort b)  Loops,Swaps: ',loops,swaps);
  139.       Writeln;
  140.       Writeln ('    Press any key to exit.');
  141.  
  142.       REPEAT UNTIL KeyPressed;
  143.       TextMode;
  144.  
  145.  END.   (************  Mainrogram  QuickSort_Demo ******************)
  146.