From NOELL%DWIFH1.BITNET@wiscvm.wisc.edu Thu Sep  3 13:01:00 1987
Date:         Thu, 03 Sep 1987 19:50 CET
From: Karl-L. Noell <NOELL%DWIFH1.BITNET@wiscvm.wisc.edu>


---------------- CUT HERE  to get  QUICK.PAS  -------------------------

                                           { K.L. Noell, fhw  09/01/87 }
  Program QuickSort_Demo (output);

  Const n = 639;            { number of columns :  x-coordinates }
        range = 199;        { actual size :        y-coordinates }
        clear_pixel = 0;
        set_pixel   = 3;
  VAR
        k: INTEGER;
        num,loops,swaps,aloops,aswaps: REAL;
        A : ARRAY [1..n] OF INTEGER;


  PROCEDURE Swap ( VAR x,y:INTEGER );
  VAR
        temp: INTEGER;

  BEGIN
        temp := x;
        x := y;
        y := temp;
        swaps := swaps + 1;
  END;  { Swap }


  FUNCTION FindPivot (i,j:INTEGER): INTEGER;
     { returns 0 if A[i], ... , A[j] have identical keys; otherwise
       returns the index of the larger of the leftmost 2 different keys }

  VAR
       firstkey: INTEGER; { value of the first key found, i.e. A[i] }
       k: INTEGER;        { runs left to right, looking for a diff. key }

  BEGIN
       firstkey := A[i];
       FindPivot := 0;                    { never found different keys }
       FOR k := i+1 TO j DO               { scan for different key     }
           IF A[k] > firstkey THEN        { select larger key          }
              FindPivot := k              { return (k)                 }
           ELSE IF A[k] < firstkey THEN
              FindPivot := i;             { return (i)                 }
  END;  { FindPivot }


  FUNCTION Partition (i,j,pivot: INTEGER): INTEGER;
    { partitions A[i], ... ,A[j] so keys < pivot are at the left
      and keys >= pivot are on the right.  Returns the beginning
      of the group on the right. }

  VAR
       l,r: INTEGER;            { cursors as described above }

  BEGIN
       l := i;
       r := j;

       REPEAT
            Plot (l,a[l],clear_pixel);
            Plot (r,A[r],clear_pixel);
            Swap (A[l],A[r]);
            Plot (l,A[l],set_pixel);
            Plot (r,A[r],set_pixel);

       { now the scan phase begins }
            WHILE A[l] <  pivot DO
                  l := l + 1;
            WHILE A[r] >= pivot DO
                  r := r - 1;
        UNTIL  l > r;

        Partition := l
  END;  { Partition }


  PROCEDURE QuickSort (i,j: INTEGER);
    { sort elements A[i], ... ,A[j] of external array A }

   VAR
       pivot: INTEGER;       { the pivot value }
       pivotindex: INTEGER;  { the index of an element of A where
                               key is the pivot }
       k: INTEGER;           { beginning index for group of elements >= piv }

  BEGIN
       loops := loops + 1;
       pivotindex := FindPivot (i,j);
       IF pivotindex <> 0 THEN BEGIN   { do nothing if all keys are equal }
          pivot := A[pivotindex];
          k := Partition (i,j,pivot);
          Quicksort (i,k-1);           { recursive call                   }
          QuickSort (k,j);             { recursive call                   }
       END
  END;  { QuickSort }


 BEGIN  (************  Mainprogram  QuickSort_Demo *****************)

      HiRes;
      HiResColor (Magenta);

      FOR k:=1 TO n DO BEGIN           { generating and sorting           }
          num := range*RANDOM;         { random numbers                   }
          A [k] := TRUNC (num);
          Plot (k,A[k],set_pixel);
      END;

      GraphBackground (Magenta);
      Palette (2);

    {Sorting start:}
      loops := 0;
      swaps := 0;

      DELAY (1000);

      QuickSort (1,n);
      aloops := loops;
      aswaps := swaps;
      Writeln ('    Quick Sort a)  Loops,Swaps: ',loops,swaps);
      Writeln;
      Writeln ('b)  Press any key to process with an array already sorted,');
      Writeln ('    but in opposite direction.');

      REPEAT UNTIL KeyPressed;

      Hires;

      FOR k:=1 TO n DO BEGIN           { generating and sorting an array  }
          num := (n-k)/(n/range);      { already sorted, but in opposite  }
          A [k] := TRUNC (num);        { direction.                       }
          PLOT (k,A[k],set_pixel);
      END;

      DELAY (1000);

      QuickSort (1,n);
      Writeln ('    Quick Sort a)  Loops,Swaps: ',aloops,aswaps);
      Writeln ('    Quick Sort b)  Loops,Swaps: ',loops,swaps);
      Writeln;
      Writeln ('    Press any key to exit.');

      REPEAT UNTIL KeyPressed;
      TextMode;

 END.   (************  Mainprogram  QuickSort_Demo *****************)

---------------- End of          Quick.PAS  ----------------------------



.