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


---------------- CUT HERE  to get  SHAKE.PAS  -------------------------

                                          { K.L. Noell, fhw 03.Sep.87 }
  PROGRAM ShakeSort_Demo (output);
  Const n = 639;            { number of columns :  x-coordinates }
        range = 199;        { actual size :        y-coordinates }
        clear_pixel = 0;
        set_pixel   = 3;
  VAR
        i1: 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 ShakeSort (np: INTEGER) ;
  VAR
     i,j,r,l: 0..n;

  BEGIN
     l := 2;
     r := np;
     i := np-1;

     REPEAT
        FOR j := r DOWNTO l DO BEGIN     { shake up }
           loops := loops + 1;
           If D[j-1] > D[j] THEN
              BEGIN
              Plot (j,D[j],clear_pixel);
              Plot ((j-1),D[j-1],clear_pixel);
              Swap (D[j],D[j-1]);
              Plot (j,D[j],set_pixel);
              Plot ((j-1),D[j-1],set_pixel);
              i := j;
              END;
        END;
        l := i + 1;

        FOR j := l TO r DO BEGIN         { shake down }
           IF D[j-1] > D[j] THEN
              BEGIN
              loops := loops + 1;
              Plot (j,D[j],clear_pixel);
              Plot ((j-1),D[j-1],clear_pixel);
              Swap (D[j],D[j-1]);
              Plot (j,D[j],set_pixel);
              Plot ((j-1),D[j-1],set_pixel);
              i := j;
              END;
        END;

        r := i - 1;
     UNTIL l > r;

  END;  { ShakeSort }


 BEGIN  (*********  Main Program  ShakeSort_Demo  *********************)
        HiRes;
        HiResColor (Brown);
        Palette (2);

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

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

        ShakeSort (n);

        aloops := loops;
        aswaps := swaps;
        Writeln ('   Shake 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;
        HiResColor (Brown);
        Palette (2);

        FOR i1:=1 TO n DO BEGIN
            num := (n-i1)/(n/range);
            D[i1] := TRUNC (num);
            Plot (i1,D[i1],set_pixel);
        END;

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

        ShakeSort (n);

        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.   (*********  Main Program  ShakeSort_Demo  *********************)

---------------- End of          SHAKE.PAS  ----------------------------



.