home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / SORT-Q-N.LIB < prev    next >
Encoding:
Text File  |  1985-07-18  |  1.4 KB  |  74 lines
  1.  
  2.  
  3. { --> 183}
  4. procedure sort(var x: ary; n: integer);
  5. { a NONRECURSIVE quicksort routine }
  6. { Adapted from 'Software-Tools',
  7.  B.Kernighan, Addison Wesley, 1976 }
  8.  
  9. var left,right : array[1..20] of integer;
  10.  i,j,sp,mid : integer;
  11.  pivot  : real;
  12.  
  13. procedure swap(var p,q: real);
  14. var hold : real;
  15.  
  16. begin
  17.   hold:=p;
  18.   p:=q;
  19.   q:=hold
  20. end;  { swap }
  21.  
  22.  
  23. begin
  24.   left[1]:=1;
  25.   right[1]:=n;
  26.   sp:=1;
  27.   while sp>0 do
  28.     begin
  29.       if left[sp]>=right[sp] then sp:=sp-1
  30.       else
  31.  begin
  32.    i:=left[sp];
  33.    j:=right[sp];
  34.    pivot:=x[j];
  35.    mid:=(i+j)div 2;
  36.    if (j-i)>5 then
  37.      if ((x[mid]<pivot)and(x[mid]>x[i]))
  38.        or
  39.   ((x[mid]>pivot)and(x[mid]<x[i]))
  40.     then swap(x[mid],x[j])
  41.      else
  42.        if((x[i]<x[mid])and(x[i]>pivot))
  43.   or ((x[i]>x[mid])and(x[i]<pivot))
  44.     then swap(x[i],x[j]);
  45.     pivot:=x[j];
  46.     while i<j do
  47.       begin
  48.  while x[i]<pivot do
  49.    i:=i+1;
  50.  j:=j-1;
  51.  while (i<j)and(pivot<x[j]) do
  52.    j:=j-1;
  53.  if i<j then swap(x[i],x[j])
  54.     end; { while }
  55.     j:=right[sp]; { pivot to i }
  56.     swap(x[i],x[j]);
  57.     if i-left[sp]>=right[sp]-i then
  58.       begin  { put shorter part first }
  59.  left[sp]+1:=left[sp];
  60.  right[sp+1]:=i-1;
  61.  left[sp]:=i+1
  62.       end
  63.     else
  64.       begin
  65.  left[sp+1]:=i+1;
  66.  right[sp+1]:=right[sp];
  67.  right[sp]:=i-1
  68.       end;
  69.     sp:=sp+1  { push stack }
  70.   end  { if }
  71.  end  { while }
  72. end; { QUICK SORT }
  73.  
  74.