home *** CD-ROM | disk | FTP | other *** search
- { 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 BubbleSort_Demo ******************)