From NOELL%DWIFH1.BITNET@wiscvm.wisc.edu Thu Sep  3 12:56:55 1987
Date:         Thu, 03 Sep 1987 19:40 CET
From: Karl-L. Noell <NOELL%DWIFH1.BITNET@wiscvm.wisc.edu>


---------------- CUT HERE  to get  HEAP.PAS  ---------------------------

                                            { K.L. Noell, fhw  03.Sep.87 }
  Program HeapSort_Demo (output);

  CONST n = 639;                   {  number of columns :  x-coordinates }
        range = 199;               {  actual values :      y-coordinates }
        clear_pixel = 0;
        set_pixel   = 3;

  VAR
        k: INTEGER;
        num,loops,swaps,aloops,aswaps: REAL;
        D : 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 }


  PROCEDURE HeapSort;
  VAR
       h,i,j,l,r: INTEGER;
       continue : BOOLEAN;

  BEGIN
       l := (n DIV 2) + 1;
       r := n;
       REPEAT
          loops := loops + 1;
             IF l > 1 THEN
                l := l -1
             ELSE
                IF r > 1 THEN
                   BEGIN
                   Plot (l,d[l],clear_pixel);
                   Plot (r,D[r],clear_pixel);
                   Swap (D[l],D[r]);
                   Plot (l,d[l],set_pixel);
                   Plot (r,D[r],set_pixel);
                   r := r - 1;
                   END;

        { next element moves through the heap: }
          i := l;
          j := 2*i;
          h := D[i];
          continue := j<=r;

          WHILE continue DO BEGIN
             loops := loops + 1;
             IF j < r THEN
                IF D[j] < D[j+1] THEN j := j+1;
             IF j <= r THEN
                continue := H < D[j] ELSE continue := FALSE;
             IF continue THEN
                 BEGIN       { Einordnung }
                    Plot (i,d[i],clear_pixel);
                    D[i] := D[j];
                    Plot (i,d[i],set_pixel);
                    i := j;
                    j := 2*i;
                 END;
          END;  { WHILE continue }

          Plot (i,D[i],clear_pixel);
          D[i] := h;
          Plot (i,D[i],set_pixel);
       UNTIL r = 1;
  END;   { HeapSort }

{ ----------------------------------------- }

 BEGIN  (************  Mainrogram  HeapSort_Demo ******************)

      HiRes;
      HiResColor (Magenta);

      FOR k:=1 to n DO BEGIN
          num := range*RANDOM;
          D [k] := TRUNC (num);
          Plot (k,D[k],set_pixel);
      END;

      GraphBackground (Magenta);
      Palette (2);

    {Sorting start:}
     loops := 0;
     swaps := 0;
     DELAY (1000);

     HeapSort;

     aloops := loops;
     aswaps := swaps;
     Writeln ('   Heap 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
         num := (n-k)/(n/range);
         D [k] := TRUNC (num);
         Plot (k,D[k],set_pixel);
     END;

   {Sorting start:}
     loops := 0;
     swaps := 0;
     DELAY (1000);

     HeapSort;

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

     REPEAT UNTIL KeyPressed;
     TextMode;

 END.   (************  Mainrogram  HeapSort_Demo ******************)

---------------- End of            HEAP.PAS  ---------------------------



.