home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DISKVR20.ZIP / QUIKSORT.INC < prev    next >
Encoding:
Text File  |  1986-01-23  |  2.4 KB  |  69 lines
  1. (*      sssss     oooo     rrrrr      ttttttt
  2.        s     s   o    o    r    r     ttttttt
  3.       s          o    o    r     r      ttt
  4.       s          o    o    r     r      ttt
  5.        s         o    o    r    r       ttt
  6.         sss      o    o    rrrrr        ttt
  7.            s     o    o    r  r         ttt
  8.             s    o    o    r   r        ttt
  9.             s    o    o    r    r       ttt
  10.       s    s     o    o    r     r      ttt
  11.        ssss       oooo     r      r     ttt                                 *)
  12. {----------------------------------------------------------------------------}
  13.     { This set of routines is a quick sort algorithem that sorts an }
  14.     { array of data and puts it in order from pos 1 to 40, you need }
  15.     { to change the compare routines if you are sorting different data }
  16. {----------------------------------------------------------------------------}
  17.  
  18. Procedure Sort_List (var values : SortArray; lo, hi : integer);
  19.   var  new_lo,
  20.        new_hi    : integer;   { used to divide the array of values }
  21.        center_value,
  22.        hold_value    :  String41;   { used when values are swapped }
  23.  
  24.   Procedure Swap_Values (Low, High: integer);
  25.     var hold_value  : String41;
  26.     begin
  27.       hold_value := values[low];
  28.       values[low] := values[high];
  29.       values[high] := hold_value;
  30.     end;  {  Swap_Values  }
  31.  
  32.   Procedure Divide_Array(left, right: integer);
  33.     var center_value,
  34.         hold_value  : String41;
  35.     begin
  36.       center_value := values[(hi + lo) div 2];
  37.       left := lo; right := hi;
  38.       while (left <= right) do
  39.       begin
  40.         while(values[left] < center_value) do
  41.           left := Succ(left);
  42.         while(values[right] > center_value) do
  43.           right := Pred(right);
  44.         if (left <= right) then
  45.         begin
  46.           Swap_Values(left,right);
  47.           left := Succ(left);
  48.           right := Pred(right);
  49.         end;  { if }
  50.       end;  { while }
  51.       new_lo := left;
  52.       new_hi := right;
  53.     end;  { divide_array }
  54.  
  55.   begin   { SortList  }
  56.     if ((hi - lo) > 1) then
  57.     begin
  58.       Divide_Array(lo,hi);
  59.       Sort_List(values,lo,new_hi);
  60.       Sort_List(values,new_lo,hi);
  61.     end
  62.     else
  63.       if ((hi - lo) = 1) then
  64.         if (values[hi] < values[lo]) then
  65.            Swap_Values(lo,hi);
  66.     end;  {  Sort_List  }
  67.  
  68.   {  end of Sort_List routine  }
  69.