home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / SORT-Q-R.LIB < prev    next >
Encoding:
Text File  |  1985-07-18  |  1012 b   |  58 lines
  1.  
  2.  
  3. { --> 180}
  4. procedure {quick} sort(var x: ary; n: integer);
  5. { a RECURSIVE sorting routine }
  6. { Adapted from 'The design of Well-Structured and Correct Programs',
  7.  S. Alagic, Springer-Verlag, 1978 }
  8.  
  9.  
  10. procedure qsort(var x: ary; m,n: integer);
  11. var i,j : integer;
  12.  
  13.  
  14. procedure partit(var a: ary; var i,j: integer; left,right: integer);
  15. var pivot : real;
  16.  
  17. procedure swap(var p,q: real);
  18. var hold : real;
  19. begin
  20.   hold:=p;
  21.   p:=q;
  22.   q:=hold
  23. end;  { swap }
  24.  
  25. begin
  26.   pivot:=a[(left+right)div 2];
  27.   i:=left;
  28.   j:=right;
  29.   while i<=j do
  30.     begin
  31.       while a[i]<pivot do
  32.  i:=i+1;
  33.       while pivot<a[j] do
  34.  j:=j-1;
  35.       if i<=j then
  36.  begin
  37.    swap(a[i],a[j]);
  38.    i:=i+1;
  39.    j:=j-1
  40.  end
  41.       end { while }
  42.   end { partit }
  43.  
  44. begin  { q-sort }
  45.   if m<n then
  46.     begin
  47.       partit(x,i,j,m,n); { divide in two }
  48.       qsort(x,m,j);  { sort left part }
  49.       qsort(x,i,n)  { sort right part }
  50.     end
  51. end;  { QSORT }
  52.  
  53. begin { sort }
  54.   qsort(x,1,n)
  55. end;  { SORT }
  56.  
  57.  
  58.