home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l320 / 2.img / EXAMPLES / QUIKSORT.P < prev    next >
Encoding:
Text File  |  1989-06-28  |  1.2 KB  |  68 lines
  1. {procedure does recursive quick sort}
  2. {NDP Fortran calling program defines array of REAL*4}
  3. {Therefore remember to compile NDP Pascal subroutine}
  4. {with P3 switch, or declare array of float}
  5.  
  6. const 
  7.   max = 300;
  8. type
  9.   ary = array[1..max] of real;
  10.  
  11. procedure swap(var x,y:real);
  12. var
  13.   tmp:real;
  14.  
  15. begin
  16.   tmp := x;
  17.   x := y;
  18.   y := tmp
  19. end {swap};
  20.  
  21. procedure quiksort_(var x:ary;var limit:integer);
  22.  
  23. var
  24.   n:integer;
  25.  
  26. procedure qsort(var x:ary;m,n:integer);
  27.  
  28. var
  29.   i,j:integer;
  30.  
  31. procedure partition(var a:ary;var i,j:integer;
  32.             left,right:integer);
  33. var
  34.   midpoint:real;
  35.  
  36. begin
  37.     midpoint := a[(left+right)div 2];
  38.     i := left;
  39.     j := right;
  40.     while i<=j do
  41.       begin
  42.         while a[i] < midpoint do
  43.       i := i + 1;
  44.         while midpoint < a[j] do    
  45.       j := j - 1;
  46.     if i <= j then
  47.        begin
  48.          swap(a[i],a[j]);
  49.          i := i + 1;
  50.          j := j - 1
  51.        end
  52.       end {while}
  53. end {partition};
  54.  
  55. begin {qsort}
  56.   if m < n then
  57.     begin
  58.       partition(x,i,j,m,n)    {divide in two};
  59.       qsort(x,m,j)    {sort left part};
  60.       qsort(x,i,n)    {sort right part}      
  61.     end
  62. end {qsort};
  63.  
  64. begin {quiksort_}
  65.   n := limit;
  66.   qsort(x,1,n)
  67. end {quiksort_};
  68.