test/SORTINGMetodos.pas

   1 { Updated SORTING.SWG on May 26, 1995 }
   2
   3 {
   4 >I've been programming for a couple years now, but there are certain things
   5 >that you seldom just figure out on your own.  One of them is the multitude
   6 >of standard sorting techniques.  I did learn these, however, in a class I
   7 >took last year in Turbo Pascal.  Let's see, Bubble Sort, Selection Sort,
   8 >Quick Sort..  I think that's what they were called.  Anyway, if anyone
   9 >has the time and desire I'd appreciate a quick run-down of each and if
  10 >possible some source for using them on a linked list.  I remember most of
  11 >the code to do them on arrays, but I forget which are the most efficient
  12 >for each type of data.
  13
  14 Here is a program that I was given to demonstrate 8 different types of sorts.
  15 I don't claim to know how they work, but it does shed some light on what the
  16 best type probably is.  BTW, it can be modified to allow for a random number
  17 of sort elements (up to maxint div 10 I believe).
  18
  19    ALLSORT.PAS: Demonstration of various sorting methods.
  20                 Released to the public domain by Wayel A. Al-Wohaibi.
  21
  22    ALLSORT.PAS was written in Turbo Pascal 3.0 (but compatible with
  23    TP6.0) while taking a pascal course in 1988. It is provided as is,
  24    to demonstrate how sorting algorithms work. Sorry, no documentation
  25    (didn't imagine it would be worth releasing) but bugs are included
  26    too!
  27
  28    ALLSORT simply shows you how elements are rearranged in each
  29    iteration of each of the eight popular sorting methods.
  30 }
  31
  32 program SORTINGMETHODS;
  33 uses
  34   Crt;
  35
  36 const
  37   N = 14;                              (* NO. OF DATA TO BE SORTED *)
  38   Digits = 3;                          (* DIGITAL SIZE OF THE DATA *)
  39   Range = 1000;                        (* RANGE FOR THE RANDOM GENERATOR *)
  40
  41 type
  42   ArrayType = array[1..N] of integer;
  43   TwoDimension = array[0..9, 1..N] of integer; (* FOR RADIX SORT ONLY *)
  44
  45 var
  46   Data : ArrayType;
  47   D : integer;
  48
  49   (*--------------------------------------------------------------------*)
  50
  51   procedure GetSortMethod;
  52   begin
  53     clrscr;
  54     writeln;
  55     writeln('                          CHOOSE:          ');
  56     writeln('                                           ');
  57     writeln('                      1 FOR SELECT SORT    ');
  58     writeln('                      2 FOR INSERT SORT    ');
  59     writeln('                      3 FOR BUBBLE SORT    ');
  60     writeln('                      4 FOR SHAKE  SORT    ');
  61     writeln('                      5 FOR HEAP   SORT    ');
  62     writeln('                      6 FOR QUICK  SORT    ');
  63     writeln('                      7 FOR SHELL  SORT    ');
  64     writeln('                      8 FOR RADIX  SORT    ');
  65     writeln('                      9 TO EXIT ALLSORT    ');
  66     writeln('                                           ');
  67     writeln;
  68     readln(D)
  69   end;
  70
  71   procedure LoadList;
  72   var
  73     I : integer;
  74   begin
  75     for I := 1 to N do
  76       Data[I] := random(Range)
  77   end;
  78
  79   procedure ShowInput;
  80   var
  81     I : integer;
  82   begin
  83     clrscr;
  84     write('INPUT :');
  85     for I := 1 to N do
  86       write(Data[I]:5);
  87     writeln
  88   end;
  89
  90   procedure ShowOutput;
  91   var
  92     I : integer;
  93   begin
  94     write('OUTPUT:');
  95     for I := 1 to N do
  96       write(Data[I]:5)
  97   end;
  98
  99   procedure Swap(var X, Y : integer);
 100   var
 101     Temp : integer;
 102   begin
 103     Temp := X;
 104     X := Y;
 105     Y := Temp
 106   end;
 107
 108   (*-------------------------- R A D I X   S O R T ---------------------*)
 109
 110   function Hash(Number, H : integer) : integer;
 111   begin
 112     case H of
 113       3 : Hash := Number mod 10;
 114       2 : Hash := (Number mod 100) div 10;
 115       1 : Hash := Number div 100
 116     end
 117   end;
 118
 119   procedure CleanArray(var TwoD : TwoDimension);
 120   var
 121     I, J : integer;
 122   begin
 123     for I := 0 to 9 do
 124       for J := 1 to N do
 125         TwoD[I, J] := 0
 126   end;
 127
 128   procedure PlaceIt(var X : TwoDimension; Number, I : integer);
 129   var
 130     J : integer;
 131     Empty : boolean;
 132   begin
 133     J := 1;
 134     Empty := false;
 135     repeat
 136       if (X[I, J] > 0) then
 137         J := J + 1
 138       else
 139         Empty := true;
 140     until (Empty) or (J = N);
 141     X[I, J] := Number
 142   end;
 143
 144   procedure UnLoadIt(X : TwoDimension; var Passed : ArrayType);
 145   var
 146     I,
 147     J,
 148     K : integer;
 149   begin
 150     K := 1;
 151     for I := 0 to 9 do
 152       for J := 1 to N do
 153         begin
 154           if (X[I, J] > 0) then
 155             begin
 156               Passed[K] := X[I, J];
 157               K := K + 1
 158             end
 159         end
 160   end;
 161
 162   procedure RadixSort(var Pass : ArrayType; N : integer);
 163   var
 164     Temp : TwoDimension;
 165     Element,
 166     Key,
 167     Digit,
 168     I : integer;
 169   begin
 170     for Digit := Digits downto 1 do
 171       begin
 172         CleanArray(Temp);
 173         for I := 1 to N do
 174           begin
 175             Element := Pass[I];
 176             Key := Hash(Element, Digit);
 177             PlaceIt(Temp, Element, Key)
 178           end;
 179         UnLoadIt(Temp, Pass);
 180         ShowOutput;
 181         readln
 182       end
 183   end;
 184
 185   (*-------------------------- H E A P   S O R T -----------------------*)
 186
 187   procedure ReHeapDown(var HEAPData : ArrayType; Root, Bottom : integer);
 188   var
 189     HeapOk : boolean;
 190     MaxChild : integer;
 191   begin
 192     HeapOk := false;
 193     while (Root * 2 <= Bottom)
 194     and not HeapOk do
 195       begin
 196         if (Root * 2 = Bottom) then
 197           MaxChild := Root * 2
 198         else
 199           if (HEAPData[Root * 2] > HEAPData[Root * 2 + 1]) then
 200             MaxChild := Root * 2
 201           else
 202             MaxChild := Root * 2 + 1;
 203         if (HEAPData[Root] < HEAPData[MaxChild]) then
 204           begin
 205             Swap(HEAPData[Root], HEAPData[MaxChild]);
 206             Root := MaxChild
 207           end
 208         else
 209           HeapOk := true
 210       end
 211   end;
 212
 213   procedure HeapSort(var Data : ArrayType; NUMElementS : integer);
 214   var
 215     NodeIndex : integer;
 216   begin
 217     for NodeIndex := (NUMElementS div 2) downto 1 do
 218       ReHeapDown(Data, NodeIndex, NUMElementS);
 219     for NodeIndex := NUMElementS downto 2 do
 220       begin
 221         Swap(Data[1], Data[NodeIndex]);
 222         ReHeapDown(Data, 1, NodeIndex - 1);
 223         ShowOutput;
 224         readln;
 225       end
 226   end;
 227
 228   (*-------------------------- I N S E R T   S O R T -------------------*)
 229
 230   procedure StrInsert(var X : ArrayType; N : integer);
 231   var
 232     J,
 233     K,
 234     Y : integer;
 235     Found : boolean;
 236   begin
 237     for J := 2 to N do
 238       begin
 239         Y := X[J];
 240         K := J - 1;
 241         Found := false;
 242         while (K >= 1)
 243         and (not Found) do
 244           if (Y < X[K]) then
 245             begin
 246               X[K + 1] := X[K];
 247               K := K - 1
 248             end
 249           else
 250             Found := true;
 251         X[K + 1] := Y;
 252         ShowOutput;
 253         readln
 254       end
 255    end;
 256
 257   (*-------------------------- S H E L L   S O R T ---------------------*)
 258
 259   procedure ShellSort(var A : ArrayType; N : integer);
 260   var
 261     Done : boolean;
 262     Jump,
 263     I,
 264     J : integer;
 265   begin
 266     Jump := N;
 267     while (Jump > 1) do
 268       begin
 269         Jump := Jump div 2;
 270         repeat
 271           Done := true;
 272           for J := 1 to (N - Jump) do
 273             begin
 274               I := J + Jump;
 275               if (A[J] > A[I]) then
 276                 begin
 277                   Swap(A[J], A[I]);
 278                   Done := false
 279                 end;
 280             end;
 281         until Done;
 282         ShowOutput;
 283         readln
 284       end
 285   end;
 286
 287   (*-------------------------- B U B B L E   S O R T -------------------*)
 288
 289   procedure BubbleSort(var X : ArrayType; N : integer);
 290   var
 291     I,
 292     J : integer;
 293   begin
 294     for I := 2 to N do
 295       begin
 296         for J := N downto I do
 297           if (X[J] < X[J - 1]) then
 298             Swap(X[J - 1], X[J]);
 299         ShowOutput;
 300         readln
 301       end
 302   end;
 303
 304   (*-------------------------- S H A K E   S O R T ---------------------*)
 305
 306   procedure ShakeSort(var X : ArrayType; N : integer);
 307   var
 308     L,
 309     R,
 310     K,
 311     J : integer;
 312   begin
 313     L := 2;
 314     R := N;
 315     K := N;
 316     repeat
 317       for J := R downto L do
 318         if (X[J] < X[J - 1]) then
 319           begin
 320             Swap(X[J], X[J - 1]);
 321             K := J
 322           end;
 323       L := K + 1;
 324       for J := L to R do
 325         if (X[J] < X[J - 1]) then
 326           begin
 327             Swap(X[J], X[J - 1]);
 328             K := J
 329           end;
 330       R := K - 1;
 331       ShowOutput;
 332       readln;
 333     until L >= R
 334   end;
 335
 336   (*-------------------------- Q W I C K   S O R T ---------------------*)
 337
 338   procedure Partition(var A : ArrayType; First, Last : integer);
 339   var
 340     Right,
 341     Left : integer;
 342     V : integer;
 343   begin
 344     V := A[(First + Last) div 2];
 345     Right := First;
 346     Left := Last;
 347     repeat
 348       while (A[Right] < V) do
 349         Right := Right + 1;
 350       while (A[Left] > V) do
 351         Left := Left - 1;
 352       if (Right <= Left) then
 353         begin
 354           Swap(A[Right], A[Left]);
 355           Right := Right + 1;
 356           Left := Left - 1
 357         end;
 358     until Right > Left;
 359     ShowOutput;
 360     readln;
 361     if (First < Left) then
 362       Partition(A, First, Left);
 363     if (Right < Last) then
 364       Partition(A, Right, Last)
 365   end;
 366
 367   procedure QuickSort(var List : ArrayType; N : integer);
 368   var
 369     First,
 370     Last : integer;
 371   begin
 372     First := 1;
 373     Last := N;
 374     if (First < Last) then
 375       Partition(List, First, Last)
 376   end;
 377
 378   (*-------------------------- S E L E C T   S O R T -------------------*)
 379
 380   procedure StrSelectSort(var X : ArrayType; N : integer);
 381   var
 382     I,
 383     J,
 384     K,
 385     Y : integer;
 386   begin
 387     for I := 1 to N - 1 do
 388       begin
 389         K := I;
 390         Y := X[I];
 391         for J := (I + 1) to N do
 392           if (X[J] < Y) then
 393             begin
 394               K := J;
 395               Y := X[J]
 396             end;
 397         X[K] := X[J];
 398         X[I] := Y;
 399         ShowOutput;
 400         readln
 401       end
 402   end;
 403
 404   (*--------------------------------------------------------------------*)
 405
 406   procedure Sort;
 407   begin
 408     case D of
 409       1 : StrSelectSort(Data, N);
 410       2 : StrInsert(Data, N);
 411       3 : BubbleSort(Data, N);
 412       4 : ShakeSort(Data, N);
 413       5 : HeapSort(Data, N);
 414       6 : QuickSort(Data, N);
 415       7 : ShellSort(Data, N);
 416       8 : RadixSort(Data, N);
 417     else
 418      writeln('BAD INPUT')
 419     end
 420   end;
 421
 422   (*-------------------------------------------------------------------*)
 423
 424 BEGIN
 425   GetSortMethod;
 426   while (D <> 9) do
 427     begin
 428       LoadList;
 429       ShowInput;
 430       Sort;
 431       writeln('PRESS ENTER TO RETURN');
 432       readln;
 433       GetSortMethod
 434     end
 435 END.