home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / sorts / compare.pas
Encoding:
Pascal/Delphi Source File  |  1994-06-07  |  14.1 KB  |  460 lines
  1. PROGRAM CompareSorts;  {Problem 23. compare at least 5 sorts}
  2.                        {included: ultra, shell, quick, heap,}
  3.                        {bubble, flip, delayed replacement   }
  4. USES      {other good sorts not used: tree sort, radix sort, hash sort }
  5.   Crt,Dos;         { To use an ultra sort I cut the size of the random }
  6. CONST              { range to 255.  This had an effect on the speed of }
  7.   Count = 1000;    { the other sorts.  Probably  more scores  of equal }
  8.   Limit = 255;     { value. The ultra sort is not really practical but }
  9. TYPE               { it makes an impressive display.                   }
  10.   Raytype = array[1..count] of integer;
  11.   Othertype = array[0..limit] of integer;
  12. {-----------------------------}
  13. Procedure FillArray(VAR List:raytype);
  14. VAR
  15.   X : integer;
  16. Begin
  17.   For X := 1 to Count Do Begin
  18.     List[X] := Random(limit) + 1;
  19.     End; {for}
  20. End;
  21. {-----------------------------}
  22. Procedure ClearArray(VAR List:OtherType);
  23. VAR
  24.   X : integer;
  25. Begin
  26.   For X := 0 to Limit Do Begin
  27.     List[X] := 0;
  28.     End; {for}
  29. End;
  30. {-----------------------------}
  31. Function Seconds : real;
  32. VAR
  33.   Hr,Min,Sec,Hund : word;
  34. Begin                        {returns total elapsed seconds since midnight}
  35.   GetTime(Hr,Min,Sec,Hund);
  36.   Seconds := Hr*3600 + Min*60 + Sec + Hund/100;
  37. End {seconds};
  38. {-----------------------------}
  39. Procedure DisplayTime(VAR Finish:real; Start:real; Adj:real);
  40. VAR
  41.   Day,Time : real;      { This procedure uses the starting time of    }
  42.   Min,Sec   : integer;  { an earlier event and returns the difference }
  43.                         { between then & now.   A correction factor   }
  44. Begin                   { for the time loop (Adj) can subtracted also.}
  45.   Finish := Seconds;            {--seconds since midnight                 }
  46.   Day := 24*3600;               {--number of  seconds in an entire day    }
  47.   Time := Finish - Start - Adj; {--difference between start and finish    }
  48.   If Time < 0 then              {--if clock cycles past midnight          }
  49.     Time := Time + Day;
  50.   Min := Trunc(Time) Div 60;    {-- print minutes }
  51.   Write(Min:3,':');
  52.   If Time-Min*60 < 10 then
  53.     Write('0',Time-Min*60:4:2) { if second less than 10 ... add zero }
  54.   Else
  55.     Write(Time-Min*60:5:2);   { - print seconds }
  56. End; {displaytime}
  57. {-----------------------------}
  58. Procedure View(List:RayType);
  59. VAR
  60.   Row,Col,Next : integer;
  61.   Ch : char;
  62.  
  63. Begin
  64.   GotoXY(1,24);
  65.   Ch := chr(32);
  66.   Write('Do you wish to view list (Y or N) ?':57);
  67.   Repeat
  68.     Ch := UpCase(ReadKey);
  69.   Until Ch In['Y','N'];
  70.   If Ch = 'Y' then Begin
  71.     Row := 6;
  72.     Col := 1;
  73.     Next:= 0;
  74.     Repeat
  75.       GotoXY(Col,Row);
  76.       Next := Next + 1;
  77.       Write(Next:4,':',List[Next]:4,chr(222));
  78.       Row  := Row + 1;
  79.       If Row = 23 then Begin
  80.         Col := Col + 10;
  81.         Row := 6;
  82.         If Col > 80 then Begin
  83.           GotoXY(1,24);
  84.           ClrEol;
  85.           Write('- press any key to continue -':48);
  86.           Ch := ReadKey;
  87.           Col := 1;
  88.           GotoXY(1,24);
  89.           ClrEol;
  90.         End; {if col}
  91.       End; {if row}
  92.     Until Next = Count;
  93.     If Row <> 23 then
  94.       GotoXY(Col,Row)
  95.     Else
  96.       If Col < 80 then
  97.         GotoXY(Col + 10,Row)
  98.       Else
  99.         GotoXY(1,8);
  100.     Write('         ',chr(222));
  101.     End; {if Y}
  102.   GotoXY(1,24);
  103.   ClrEol;
  104. End; {view}
  105. {-----------------------------}
  106. Procedure UltraSort(VAR NumList:raytype; VAR FreqTab:othertype);
  107. VAR
  108.   Y,X,W : integer;   { based on logic taken from 'PASCALGORYTHM' }
  109.                      { there could not be a faster sort!         }
  110. Begin
  111.   For X := 0 to Count Do Begin
  112.     FreqTab[NumList[X]] := FreqTab[NumList[X]] + 1;
  113.     End;
  114.   Y := 0;
  115.   For X := 0 to Limit Do Begin
  116.     If FreqTab[X] > 0 then Begin
  117.       For W := 1 to FreqTab[X] Do Begin
  118.         Y := Y + 1;
  119.         NumList[Y] := X;
  120.         End; {for}
  121.       End; {if}
  122.     End; {for x}
  123. End; {ultrasort}
  124. {-----------------------------}
  125. Procedure Mergesort(VAR List1 : RayType; lo,hi : integer);
  126. {
  127.    Sorts  List1[lo] through List1[hi] ... inclusive
  128. }
  129. VAR
  130.   t,size : integer;
  131. {..............................}
  132. Procedure Merges(VAR List1 : RayType; lo,hi:integer);
  133. VAR
  134.   i,j,k,mid,m,n : integer;
  135.   Temp : RayType;
  136. Begin
  137.   k := 1;
  138.   j := 1;
  139.   i := 1;
  140.   lo := lo - 1;
  141.   mid := (lo + hi) Div 2;
  142.   m := mid - lo;
  143.   n := hi - mid;
  144.   While k <= m + n Do Begin
  145.     If i > m then Begin
  146.       Temp[k] := List1[mid + j];
  147.       j := j + 1;
  148.       End {if i}
  149.     Else If j > n then Begin
  150.       Temp[k] := List1[lo + i];
  151.       i := i + 1;
  152.       End {if j}
  153.     Else If List1[lo + i] <= List1[mid + j] then Begin
  154.       Temp[k] := List1[lo + i];
  155.       i := i + 1;
  156.       End {if lo}
  157.     Else Begin
  158.       Temp[k] := List1[mid + j];
  159.       j := j + 1;
  160.       End; {mid}
  161.     k := k +1;
  162.   End; {while}
  163.   For k := 1 to m + n Do
  164.     List1[lo + k] := Temp[k];
  165. End; {merges}
  166. {.............................}
  167. Begin {mergesort}
  168.   size := hi - lo + 1;
  169.   If (size = 2) and (List1[hi] < List1[lo]) then Begin {exchange}
  170.     t := List1[hi];
  171.     List1[hi] := List1[lo];
  172.     List1[lo] := t;
  173.     End {swap}
  174.   Else If size > 2 then Begin
  175.     Mergesort(List1,lo,lo - 1 + size Div 2);
  176.     Mergesort(List1,lo + size Div 2,hi);
  177.     Merges(List1,lo,hi)
  178.     End; {else > 2}
  179. End; {mergesort}
  180. {-----------------------------}
  181. Procedure Shellsort(VAR List:raytype; N:integer);
  182. VAR
  183.   X,Right,Lptr,Rptr,Gap,Temp : integer; { After my meeting with you 9/3 }
  184.   Change : boolean;                     { I looked up shell sort in the }
  185. Begin                               { the other references you provided }
  186.   Gap := N;                         { me. None seemed to be the same as }
  187.     While Gap > 0 Do Begin          { we discussed. So I build this one }
  188.     Gap := Gap Div 2;               { from scratch.  I was very pleased }
  189.     Right := N - Gap;               { with the result. According to the }
  190.     For X := 1 to Right Do Begin    { book 'PASCALGORITHM' It should be }
  191.       Lptr := X;                    { slightly  faster than  MERGESORT. }
  192.       Repeat
  193.         Rptr := Lptr + Gap;
  194.         If List[Lptr] > List[Rptr] then Begin
  195.           Temp := List[Lptr];
  196.           List[Lptr] := List[Rptr];
  197.           List[Rptr] := Temp;
  198.           Change := true;
  199.           Lptr := Lptr - Gap;
  200.           End
  201.         Else
  202.           Change := false;
  203.       Until (Lptr < 1) or Not Change;
  204.       End; {for}
  205.     End; {while}
  206. End; {shellsort}
  207. {-----------------------------}
  208. Procedure BubbleSort(VAR List:RayType; N:integer);
  209. VAR
  210.   X,Y,Temp : integer;
  211. Begin
  212.   For X := 1 to N - 1 Do Begin
  213.     For Y := X + 1 to N Do Begin
  214.       If List[X] > List[Y] then Begin
  215.         Temp := List[X];
  216.         List[X] := List[Y];
  217.         List[Y] := Temp;
  218.         End; {if}
  219.     End; {for y}
  220.   End; {for x}
  221. End; {bubblesort}
  222. {----------------------------}
  223. Procedure QuickSort(VAR A:raytype; L,R : integer);
  224. {
  225.    Sorts array A[L..R], where the main program has set A[R + 1] to
  226.    "infinity," that is, a number guaranteed to be larger than any A[L..R]
  227. }
  228. VAR
  229.   i,j,PIV,t : integer;
  230. Begin
  231.   If L < R then Begin
  232.     i := L + 1;           { initialize left pointer }
  233.     j := R;               { initialize right pointer }
  234.     PIV := A[L];          { select left most array element for a pivot }
  235.     Repeat  { move the pointers i & j as far inward as possible }
  236.       While A[i] <= PIV Do
  237.         i := i + 1;        { move left pointer to the right }
  238.       While A[j] > PIV Do
  239.         j := j - 1;        { move right pointer to the left }
  240.       If i < j then Begin  { exchange items pointed to by i and j}
  241.         t := A[i];
  242.         A[i] := A[j];
  243.         A[j] := t;
  244.         End;
  245.     Until i > j;
  246.                   { now two final replacements complete a partitioning }
  247.     A[L] := A[j];
  248.     A[j] := PIV;
  249.           { finish by recursively sorting the left and right partitions}
  250.     Quicksort(A,L,j - 1);
  251.     Quicksort(A,i,R)
  252.     End;   { logic performed only when L < R }
  253. End; {quicksort}
  254. {----------------------------}
  255. Procedure FlipSort(VAR List:Raytype; N :integer);
  256. VAR
  257.   X,Temp,Top,Bot,Flips : integer; { This is my sort, Now I admit that it is }
  258.                                   { not fast,  but at the time I thought of }
  259. Begin                             { it, I didn't know what a fast sort was. }
  260.   Bot := N;                       { Its value comes in an array where  only }
  261.   Top := 1;                       { a few elements need to be sorted. After }
  262.   Repeat                          { an editing session.                     }
  263.     Flips := 0;
  264.     For X := Bot downto Top + 1 Do Begin
  265.       If List[X] < List[X-1] then Begin
  266.         Temp := List[X];
  267.         List[X] := List[X-1];
  268.         List[X-1] := Temp;
  269.         Flips := Flips + 1;
  270.         End; {if}
  271.       End; {going up}
  272.     Top := Top +1;
  273.     If Flips > 0 Then Begin
  274.       Flips := 0;
  275.       For X := Top to Bot - 1 Do Begin
  276.         If List[X] > List[X+1] then Begin
  277.           Temp := List[X];
  278.           List[X] := List[X+1];
  279.           List[X+1] := Temp;
  280.           Flips := Flips + 1;
  281.           End; {if}
  282.         End; {for}
  283.       End; {if}
  284.       Bot := Bot-1;
  285.   Until (Flips = 0) or (Top >= Bot);
  286. End; {flipsort}
  287. {-----------------------------}
  288. Procedure DelaySort(VAR List:RayType; N:integer);
  289. VAR
  290.   X,Y,Temp,SmallPtr : integer;
  291.                                     { this sorts small to large }
  292. Begin
  293.   For X := 1 to N - 1 Do Begin
  294.     SmallPtr := X;
  295.     For Y := X + 1 to N Do Begin
  296.       If List[SmallPtr] > List[Y] then
  297.         SmallPtr := Y;
  298.       End; {for y}
  299.     Temp := List[X];
  300.     List[X] := List[SmallPtr];
  301.     List[SmallPtr] := Temp;
  302.   End; {for X}
  303. End; {delaysort}
  304. {------------------------}
  305. Procedure Heapsort(VAR A:raytype; N:integer);
  306. VAR
  307.   i : integer;
  308.   Procedure Exchange(VAR a,b : integer);
  309.   VAR
  310.     t : integer;
  311.   Begin
  312.     t := a;
  313.     a := b;
  314.     b := t;
  315.   End; {exchange}
  316.   {----------}
  317.   Procedure Rebuild(j,m : integer);
  318.   VAR
  319.     k : integer;
  320.     sinking : boolean;
  321.   Begin
  322.     sinking := true;
  323.     k := j + 1;
  324.     While (k <= m) and sinking Do Begin
  325.       If a[k] < a[k + 1] then
  326.         If k < m then
  327.           k := k + 1;    {find the larger child}
  328.       If a[j] < a[k] then {exchange a[j] with the larger of its children}
  329.         Begin
  330.           Exchange(a[j],a[k]);
  331.           j := k;   {advance j to point to latest point of insertion}
  332.           k := 2*k  {advance k to point to first child of old k     }
  333.         End         {to see if item should further sink down        }
  334.       Else          {change sentinel to force termination           }
  335.         sinking := false
  336.     End
  337.   End; {rebuild}
  338.   {----------}
  339.   Procedure Buildheap;
  340.   VAR
  341.     i : integer;
  342.   Begin
  343.     For i := n Div 2 downto 1 Do
  344.       Rebuild(i,n);
  345.   End; {buildheap}
  346.   {----------}
  347. BEGIN  {heapsort}
  348.   Buildheap;
  349.   For i := n downto 2 Do Begin
  350.     Exchange(a[1],a[i]);  { exchange top of heap and current last element }
  351.     Rebuild(1,i-1)        { restore heap }
  352.     End;
  353. END; {heapsort}
  354. {-----------------------------}
  355. Procedure Empty(VAR List:raytype);
  356. Begin
  357. End;
  358. {-----------------------------}
  359. VAR
  360.   FreqTab : othertype;
  361.   TestList,OriginList : raytype;
  362.   X   : integer;
  363.   Start,Adj,Finish : real;
  364. Begin       {main}
  365.   Randomize;
  366.   ClrScr;
  367.   Writeln(' 23. Run various sorts with a common array to compare the',
  368.         ' completion time.');
  369.   For X := 1 to 80 Do Write(chr(196));
  370.   Writeln; Writeln;
  371.   For X := 1 to 80 Do Write(chr(196));
  372.   GotoXY(1,23);
  373.   For X := 1 to 80 Do Write(chr(196));
  374.   ClearArray(FreqTab);
  375.   FillArray(TestList);
  376.   OriginList := TestList; { save array before sort }
  377. {----------------------------}
  378.   GotoXY(24,24);                   { This is a check to see if the program }
  379.   Adj := 0;                        { uses any time during the Seconds  and }
  380.   Write('Adjustment = ');          { and DisplayTime procedure calls.  The }
  381.   Start := Seconds;                { variable Adj will then adjust any use }
  382.   Empty(TestList);                 { of this sequence  in future uses.  It }
  383.   DisplayTime(Finish,Start,Adj);   { appears  after  running  this program }
  384.   Adj := Finish - Start;           { that it was not needed, but I left it }
  385. {----------------------------        in in case this is run on a slow comp.}
  386.   GotoXY(1,3); Write('BubbleSort');{ to adjust for a slow display.         }
  387.   GotoXY(1,4);
  388.   Start := Seconds;
  389.   BubbleSort(TestList,Count);
  390.   DisplayTime(Finish,Start,Adj);
  391.   Write(^G);
  392.   View(TestList);
  393.   TestList := OriginList;
  394. {-----------------------------}
  395.   GotoXY(12,3); Write('FlipSort');
  396.   GotoXY(11,4);
  397.   Start := Seconds;
  398.   FlipSort(TestList,Count);
  399.   DisplayTime(Finish,Start,Adj);
  400.   Write(^G);
  401.   View(TestList);
  402.   TestList := OriginList;
  403.   TestList := OriginList;
  404. {----------------------------}
  405.   GotoXY(22,3); Write('DelaySort');
  406.   GotoXY(21,4);
  407.   Start := Seconds;
  408.   DelaySort(TestList,Count);
  409.   DisplayTime(Finish,Start,Adj);
  410.   Write(^G);
  411.   View(TestList);
  412.   TestList := OriginList;
  413. {----------------------------}
  414.   GotoXY(32,3); Write('HeapSort');
  415.   GotoXY(31,4);
  416.   Start := Seconds;
  417.   Heapsort(TestList,Count);
  418.   DisplayTime(Finish,Start,Adj);
  419.   Write(^G);
  420.   View(TestList);
  421.   TestList := OriginList;
  422. {----------------------------}
  423.   GotoXY(42,3); Write('ShellSort');
  424.   GotoXY(41,4);
  425.   Start := Seconds;
  426.   ShellSort(TestList,Count);
  427.   DisplayTime(Finish,Start,Adj);
  428.   Write(^G);
  429.   View(TestList);
  430.   TestList := OriginList;
  431. {----------------------------}
  432.   GotoXY(52,3); Write('MergeSort');
  433.   GotoXY(51,4);
  434.   Start := Seconds;
  435.   MergeSort(TestList,1,Count);
  436.   DisplayTime(Finish,Start,Adj);
  437.   Write(^G);
  438.   View(TestList);
  439.   TestList := OriginList;
  440. {----------------------------}
  441.   GotoXY(62,3); Write('QuickSort');
  442.   GotoXY(61,4);
  443.   Start := Seconds;
  444.   QuickSort(TestList,1,Count);
  445.   DisplayTime(Finish,Start,Adj);
  446.   Write(^G);
  447.   View(TestList);
  448.   TestList := OriginList;
  449. {----------------------------}
  450.   GotoXY(72,3); Write('UltraSrt');
  451.   GotoXY(71,4);
  452.   Start := Seconds;
  453.   UltraSort(TestList,FreqTab);
  454.   DisplayTime(Finish,Start,Adj);
  455.   Write(^G);
  456.   View(TestList);
  457.   TestList := OriginList;
  458. {----------------------------}
  459. End. {compare}
  460.