home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / QUICKSOR.MOD < prev    next >
Text File  |  1996-09-27  |  7KB  |  205 lines
  1. IMPLEMENTATION MODULE QuickSortModule;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*      In-memory sort using the QuickSort method       *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        27 September 1996               *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. FROM SYSTEM IMPORT
  14.     (* type *)  LOC, ADDRESS,
  15.     (* proc *)  ADR, DIFADR;
  16.  
  17. FROM Storage IMPORT
  18.     (* proc *)  ALLOCATE, DEALLOCATE;
  19.  
  20. FROM LowLevel IMPORT
  21.     (* proc *)  Copy,
  22.     (* proc *)  AddOffset, SubtractOffset;
  23.  
  24. (************************************************************************)
  25.  
  26. TYPE
  27.     EltPointer = ADDRESS;
  28.     Array = RECORD
  29.                 location: ADDRESS;
  30.                 eltsize: CARDINAL;
  31.                 greaterorequal: CompareProc;
  32.             END (*RECORD*);
  33.  
  34. (************************************************************************)
  35.  
  36. PROCEDURE CmpPtr (pa, pb: EltPointer): INTEGER;
  37.  
  38.     (* Returns -1 if pa<pb, 0 if pa=pb, +1 if pa>pb.    *)
  39.  
  40.     VAR difference: INTEGER;
  41.  
  42.     BEGIN
  43.         difference := DIFADR (pa, pb);
  44.         IF difference < 0 THEN RETURN -1;
  45.         ELSIF difference > 0 THEN RETURN +1;
  46.         ELSE RETURN 0;
  47.         END (*IF*);
  48.     END CmpPtr;
  49.  
  50. (************************************************************************)
  51.  
  52. PROCEDURE PtrDiff (high, low: ADDRESS): CARDINAL;
  53.  
  54.     (* Returns Physical(high) - Physical(low)   *)
  55.  
  56.     BEGIN
  57.         RETURN DIFADR (high, low);
  58.     END PtrDiff;
  59.  
  60. (************************************************************************)
  61.  
  62. PROCEDURE Partition ( VAR (*INOUT*) A: Array;  low: EltPointer;
  63.                         VAR (*OUT*) mid: EltPointer;  high: EltPointer);
  64.  
  65.     (* By shuffling elements of A as necessary, ensures the property    *)
  66.     (*          A[j] <= v       for low <= j < mid                      *)
  67.     (*          A[mid] = v                                              *)
  68.     (*          A[j] >= v       for mid < j <= high                     *)
  69.     (* where v is some unspecified value chosen by the procedure.       *)
  70.     (* Input assumption: high > low, i.e. more than one element.        *)
  71.     (* Remark: for an array of <=3 elements, this procedure completely  *)
  72.     (* sorts the array.                                                 *)
  73.  
  74.     VAR up, down, temp: EltPointer;  N: CARDINAL;
  75.  
  76.     BEGIN
  77.         down := low;  up := high;
  78.         N := PtrDiff (high, low) DIV A.eltsize + 1;
  79.         mid := AddOffset (low, A.eltsize * (N DIV 2));
  80.  
  81.         ALLOCATE (temp, A.eltsize);
  82.  
  83.         (* Pre-sort: first we put the first, middle and last elements   *)
  84.         (* in their correct relative order.                             *)
  85.         (* To begin with, ensure that high^ >= low^.                    *)
  86.  
  87.         IF NOT A.greaterorequal(high, low) THEN
  88.             Copy (low, temp, A.eltsize);
  89.             Copy (high, low, A.eltsize);
  90.             Copy (temp, high, A.eltsize);
  91.         END (*IF*);
  92.         IF N = 2 THEN
  93.             DEALLOCATE (temp, A.eltsize);  RETURN;
  94.         END (*IF*);
  95.  
  96.         (* Load the middle element into temp^.  By swapping elements as *)
  97.         (* necessary, ensure that high^ >= temp^ >= low^.               *)
  98.  
  99.         Copy (mid, temp, A.eltsize);
  100.         IF NOT A.greaterorequal (mid, low) THEN
  101.             Copy (low, temp, A.eltsize);
  102.             Copy (mid, low, A.eltsize);
  103.         ELSIF NOT A.greaterorequal (high, mid) THEN
  104.             Copy (high, temp, A.eltsize);
  105.             Copy (mid, high, A.eltsize);
  106.         END (*IF*);
  107.  
  108.         (* For an array of <=3 elements, the above pre-sort is actually *)
  109.         (* a complete sort.                                             *)
  110.  
  111.         IF N <= 3 THEN
  112.             Copy (temp, mid, A.eltsize);
  113.             DEALLOCATE (temp, A.eltsize);  RETURN;
  114.         END (*IF*);
  115.  
  116.         (* v = temp^ *)
  117.  
  118.         LOOP
  119.             WHILE (CmpPtr (down, mid) < 0) AND A.greaterorequal (temp, down) DO
  120.                 down := AddOffset (down, A.eltsize);
  121.             END (*WHILE*);
  122.  
  123.             (* All elements below down^ <= a                    *)
  124.             (* ((down^ > v) AND (down < mid)) OR down >= mid    *)
  125.  
  126.             IF CmpPtr (down, mid) < 0 THEN
  127.  
  128.                 (* All elements below down^ <= v        *)
  129.                 (* (down^ > v) AND (down < mid)         *)
  130.  
  131.                 Copy (down, mid, A.eltsize);
  132.                 mid := down;
  133.                 down := AddOffset (down, A.eltsize);
  134.  
  135.                 (* hole at mid < down   *)
  136.  
  137.             END (*IF*);
  138.  
  139.             (* Note that down >= mid at this point.     *)
  140.  
  141.             WHILE (CmpPtr (up, mid) > 0) AND A.greaterorequal (up, temp) DO
  142.                 up := SubtractOffset (up, A.eltsize);
  143.             END (*WHILE*);
  144.  
  145.             (* All elements above up^ >= v                      *)
  146.             (* ((up^ < v) AND (up > mid)) OR up <= mid          *)
  147.  
  148.             IF CmpPtr (up, mid) <= 0 THEN EXIT(*LOOP*) END(*IF*);
  149.  
  150.             Copy (up, mid, A.eltsize);
  151.             mid := up;
  152.             up := SubtractOffset (up, A.eltsize);
  153.  
  154.             (* hole at mid > up *)
  155.  
  156.         END (*LOOP*);
  157.         Copy (temp, mid, A.eltsize);
  158.         DEALLOCATE (temp, A.eltsize);
  159.     END Partition;
  160.  
  161. (************************************************************************)
  162.  
  163. PROCEDURE Sort ( VAR (*INOUT*) A: Array;  low, high: EltPointer);
  164.  
  165.     (* Sorts the subarray A[low..high] inclusive.       *)
  166.  
  167.     VAR mid: EltPointer;
  168.  
  169.     BEGIN
  170.         WHILE CmpPtr (high, low) > 0 DO
  171.             Partition (A, low, mid, high);
  172.             IF CmpPtr (mid, low) > 0 THEN
  173.                 Sort (A, low, SubtractOffset (mid, A.eltsize));
  174.             END (*IF*);
  175.             low := AddOffset (mid, A.eltsize);
  176.         END (*WHILE*);
  177.     END Sort;
  178.  
  179. (************************************************************************)
  180. (*                         THE END-USER VERSION                         *)
  181. (************************************************************************)
  182.  
  183. PROCEDURE QuickSort (VAR (*INOUT*) data: ARRAY OF LOC;
  184.                                 N, EltSize: CARDINAL;  GE: CompareProc);
  185.  
  186.     (* In-place sort of array data[0..N].  EltSize is the element size, *)
  187.     (* and GE is a user-supplied function to compare elements at two    *)
  188.     (* specified addresses.                                             *)
  189.  
  190.     VAR A: Array;
  191.  
  192.     BEGIN
  193.         WITH A DO
  194.             location := ADR (data);
  195.             eltsize := EltSize;
  196.             greaterorequal := GE;
  197.             Sort (A, location, AddOffset (location, N*EltSize));
  198.         END (*WITH*);
  199.     END QuickSort;
  200.  
  201. (************************************************************************)
  202.  
  203. END QuickSortModule.
  204. 
  205.