home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0015_QUICK1.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  1.8 KB  |  83 lines
  1. Unit Qsort;
  2.  
  3. {
  4.  
  5. Copyright 1990 Trevor J Carlsen
  6. All rights reserved.
  7.  
  8. Author:   Trevor J Carlsen
  9.           PO Box 568
  10.           Port Hedland WA 6721
  11.           
  12. A general purpose sorting Unit.
  13.  
  14.  
  15. }
  16.  
  17. Interface
  18.  
  19. Type
  20.   updown   = (ascending,descending);
  21.   str255   = String;
  22.   dataType = str255;     { the Type of data to be sorted }
  23.   dataptr  = ^dataType;
  24.   ptrArray = Array[1..10000] of dataptr;
  25.   Arrayptr = ^ptrArray;
  26.   
  27. Const 
  28.   maxsize  : Word = 10000;
  29.   SortType : updown = ascending;
  30.  
  31. Procedure QuickSort(Var da; left,right : Word);
  32.  
  33. {============================================================================}
  34. Implementation
  35.  
  36. Procedure swap(Var a,b : dataptr);  { Swap the Pointers }
  37.   Var  t : dataptr;
  38.   begin
  39.     t := a;
  40.     a := b;
  41.     b := t;
  42.   end;
  43.  
  44.     
  45. Procedure QuickSort(Var da; left,right : Word);
  46.   Var
  47.     d       : ptrArray Absolute da;
  48.     pivot   : dataType;
  49.     lower,
  50.     upper,
  51.     middle  : Word;
  52.  
  53.   begin
  54.     lower := left;
  55.     upper := right;
  56.     middle:= (left + right) div 2;
  57.     pivot := d[middle]^;
  58.     Repeat
  59.       Case SortType of
  60.       ascending :  begin
  61.                      While d[lower]^ < pivot do inc(lower);
  62.                      While pivot < d[upper]^ do dec(upper);
  63.                    end;
  64.       descending:  begin
  65.                      While d[lower]^ > pivot do inc(lower);
  66.                      While pivot > d[upper]^ do dec(upper);
  67.                    end;
  68.       end; { Case }                    
  69.       if lower <= upper then begin
  70.         { swap the Pointers not the data }
  71.         swap(d[lower],d[upper]);
  72.         inc(lower);
  73.         dec(upper);
  74.       end;
  75.     Until lower > upper;
  76.     if left < upper then QuickSort(d,left,upper);
  77.     if lower < right then QuickSort(d,lower,right);
  78.   end;  { QuickSort }
  79.  
  80. end.
  81.  
  82.  
  83.