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


---------------- CUT HERE  to get  LINEAR.PAS  -------------------------

                                            {  K.L. Noell, fhw 03.Sep.87 }
 PROGRAM LinearSort_Demo (output);
 CONST n=639;
       range = 199;
       clear_pixel = 0;
       set_pixel =   3;
 VAR
       k: INTEGER;
       num,loops,swaps,aloops,aswaps: REAL;
       D: array [0..n] of INTEGER;

 PROCEDURE LinSort ;
  { Sortieren des Feldes D }

 VAR   r,l : 0..n;
       h : INTEGER;
       finis : BOOLEAN;

 BEGIN
    FOR r := 2 TO n DO BEGIN
       finis := FALSE;
       h := D[r];
       l := r - 1;

       WHILE NOT finis AND (l>0) DO  BEGIN
          loops := loops + 1;
          IF h < D[l]
             THEN BEGIN
                  swaps := swaps + 1;
                  Plot ((l+1),D[l+1],clear_pixel);
                  D[l+1] := D[l];
                  Plot ((l+1),D[l+1],set_pixel);
                  l := l - 1;
             END
             ELSE finis := TRUE;
       END;

       swaps := swaps + 1;
       Plot ((l+1),D[l+1],clear_pixel);
       D[l+1] := h;
       Plot ((l+1),D[l+1],set_pixel);

    END;
 END;  { Linsort }


 BEGIN  (********  Mainprogram  LinearSort_Demo  ********************)

        HiRes;
        HiResColor (Brown);
        Palette (2);

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

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

        Linsort ;

        aloops := loops;
        aswaps := swaps;
        Writeln ('   Linear 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;
        GraphBackground(6);
        Palette(2);

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

        loops := 0;
        swaps := 0;
        DELAY (1000);

        LinSort ;

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

        REPEAT UNTIL KeyPressed;
        TextMode;

 END.   (********  Mainprogram  LinearSort_Demo  ********************)

---------------- End of        LINEAR.PAS  -----------------------------



.