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


---------------- CUT HERE  to get  SHELL.PAS  -------------------------

                                           { K.L. Noell, fhw  09/01/87 }
  Program ShellSort_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 }


  PROCEDURE ShellSort ;
  VAR
     i,j,incr:INTEGER;

  BEGIN
        incr := n DIV 2;
        WHILE incr > 0 DO BEGIN
              FOR i := incr + 1 TO n do BEGIN
                  j := i - incr;
                  loops := loops + 1;
                  WHILE j > 0 DO
                        if A[j] > A[j+incr] THEN BEGIN
                           loops := loops + 1;
                           Plot (j,A[j],clear_pixel);
                           Plot ((j+incr),A[j+incr],clear_pixel);
                           Swap (A[j],A[j+incr]);
                           Plot (j,A[j],set_pixel);
                           Plot ((j+incr),A[j+incr],set_pixel);
                           j := j - incr
                        END
                        ELSE
                        j := 0 {break}
              END;
        incr := incr DIV 2;
        END;
  END;  { ShellSort }


 BEGIN  (************  Mainrogram  ShellSort_Demo ******************)

        HiRes;
        HiResColor (Magenta);
                                   { a):  generating and sorting    }
        FOR k:=1 TO n DO BEGIN     {      randomly distributed keys }
            num := range*RANDOM;
            A [k] := TRUNC (num);
            Plot (k,A[k],set_pixel);
        END;

        GraphBackground (Magenta);
        Palette (2);

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

        ShellSort ;

        aloops := loops;
        aswaps := swaps;
        Writeln ('   Shell 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;
                                   { b):  generating and sorting       }
        FOR k:=1 TO n DO BEGIN     {      keys beeing in opposed order }
            num := (n-k)/(n/range);
            A [k] := TRUNC (num);
            Plot (k,A[k],set_pixel);
        END;

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

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

        REPEAT UNTIL KeyPressed;
        TextMode;

 END.   (************  Mainrogram  ShellSort_Demo ******************)

---------------- End of          SHELL.PAS  ----------------------------



.