test/SORTINGMetodos.pas

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