home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / txtutl / sortdemo.arc / SHELL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-01  |  3.0 KB  |  107 lines
  1.                                            { K.L. Noell, fhw  09/01/87 }
  2.   Program ShellSort_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.   PROCEDURE ShellSort ;
  27.   VAR
  28.      i,j,incr:INTEGER;
  29.  
  30.   BEGIN
  31.         incr := n DIV 2;
  32.         WHILE incr > 0 DO BEGIN
  33.               FOR i := incr + 1 TO n do BEGIN
  34.                   j := i - incr;
  35.                   loops := loops + 1;
  36.                   WHILE j > 0 DO
  37.                         if A[j] > A[j+incr] THEN BEGIN
  38.                            loops := loops + 1;
  39.                            Plot (j,A[j],clear_pixel);
  40.                            Plot ((j+incr),A[j+incr],clear_pixel);
  41.                            Swap (A[j],A[j+incr]);
  42.                            Plot (j,A[j],set_pixel);
  43.                            Plot ((j+incr),A[j+incr],set_pixel);
  44.                            j := j - incr
  45.                         END
  46.                         ELSE
  47.                         j := 0 {break}
  48.               END;
  49.         incr := incr DIV 2;
  50.         END;
  51.   END;  { ShellSort }
  52.  
  53.  
  54.  BEGIN  (************  Mainrogram  ShellSort_Demo ******************)
  55.  
  56.         HiRes;
  57.         HiResColor (Magenta);
  58.                                    { a):  generating and sorting    }
  59.         FOR k:=1 TO n DO BEGIN     {      randomly distributed keys }
  60.             num := range*RANDOM;
  61.             A [k] := TRUNC (num);
  62.             Plot (k,A[k],set_pixel);
  63.         END;
  64.  
  65.         GraphBackground (Magenta);
  66.         Palette (2);
  67.  
  68.         {Sorting start:}
  69.         loops := 0;
  70.         swaps := 0;
  71.         DELAY (1000);
  72.  
  73.         ShellSort ;
  74.  
  75.         aloops := loops;
  76.         aswaps := swaps;
  77.         Writeln ('   Shell Sort a)  Loops,Swaps: ',loops,swaps);
  78.         Writeln;
  79.         Writeln ('b) Press any key to process with an array already sorted,');
  80.         Writeln ('   but in opposite direction.');
  81.  
  82.         REPEAT UNTIL KeyPressed;
  83.  
  84.         Hires;
  85.                                    { b):  generating and sorting       }
  86.         FOR k:=1 TO n DO BEGIN     {      keys beeing in opposed order }
  87.             num := (n-k)/(n/range);
  88.             A [k] := TRUNC (num);
  89.             Plot (k,A[k],set_pixel);
  90.         END;
  91.  
  92.         {Sorting start:}
  93.         loops := 0;
  94.         swaps := 0;
  95.         DELAY (1000);
  96.  
  97.         ShellSort ;
  98.         Writeln (' Shell Sort a)  Loops,Swaps: ',aloops,aswaps);
  99.         Writeln (' Shell Sort b)  Loops,Swaps: ',loops,swaps);
  100.         Writeln;
  101.         Writeln (' Press any key to exit.');
  102.  
  103.         REPEAT UNTIL KeyPressed;
  104.         TextMode;
  105.  
  106.  END.   (************  Mainrogram  ShellSort_Demo ******************)
  107.