home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol131 / qqsortr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  5.5 KB  |  145 lines
  1. FUNCTION qqsort_real( VAR A :real_array ;
  2.                       left_1st,right_1st : INTEGER ) : BOOLEAN;
  3. {
  4.  Original Author : Richard C. Singleton (Sept 17, 1968)
  5.  Reference       : Algorithm 347 ;Collected Algorithms of ACM.
  6.     This function sorts the REAL array A ,from A[left_1st] to
  7.   A[right_1st] , into ASCENDING order . To sort the entire array  A set
  8.   left_1st := 1 , and right_1st := N ,where N is the order of the array.
  9.   If the value passed for left_1st is less than or equal to the value
  10.   passed for right_1st then no sorting is done and the function returns
  11.   false.
  12.     The sort method used is similar to QUICKERSORT by  R. S. Scowen
  13.   (alg.271 ACM) which in turn is similar to the sort algorithm given by 
  14.   T.N.Hibbard and to C.A.R.Hoare's QUICKSORT ( alg.64 ACM ) .Unlike the
  15.   original QUICKSORT it is not truly recursive.
  16.     The initial segment of the array A is split into left and right
  17.   "halves" composed of elements smaller and larger respectively than the
  18.   median of the leftmost , middle and rightmost members of the initial
  19.   segment.The smaller of the 2 "halves" is split similarly and the basic
  20.   process repeated until a subsegment is produced with fewer than eleven
  21.   elements.Once such a subsegment is formed it is sorted by a straight 
  22.   sinking insertion sort.
  23.     The left and right bounds of the larger subsegment at each 
  24.   iteration are "stacked" in the arrays "left_bound" & "right_bound" and
  25.   "popped off"  once the smaller segment is fully sorted.Then the popped
  26.   of segment is  treated as was the initial segment etc. until the entire
  27.   initial segment is done.
  28.  
  29. Modified for Pascal/Z : October 1980 : Ray Penley
  30.                 September 82 : Greg Acland
  31. }
  32. CONST
  33.     konst        = 20;
  34. VAR
  35.     middle,
  36.     tempvar        : REAL;
  37.     left,right,
  38.     newleft,newright,
  39.     mid_index,
  40.     element,pointer : INTEGER;
  41.     left_bound,
  42.     right_bound    : ARRAY [0..konst] OF INTEGER;
  43.              {Permit sorting up to 2EXP(konst + 1)-1 elements}
  44.     alldone,
  45.     past_midpoint,
  46.     first,ok_array  : BOOLEAN;
  47.  
  48. BEGIN                 {$C-,M-,F-}
  49.   left        := left_1st;
  50.   right        := right_1st;
  51.   pointer    := 0;
  52.   first        := TRUE;
  53.   alldone    := FALSE;
  54.   ok_array    := left < right;
  55.   IF ok_array THEN BEGIN
  56.    REPEAT
  57.      IF ((right-left) > 10)      {IF   : the segment has > 10 members}
  58.      OR ( first )                {OR   : it is the initial segment   }
  59.       THEN BEGIN                 {THEN : use splitting algorithm     }
  60.        IF first THEN first := FALSE;
  61.      { step 1 = find the middle element of the segment }
  62.        mid_index    := (left+right) DIV 2;
  63.        middle        := A[mid_index];
  64.        newright        := left;
  65.        newleft        := right;
  66.      { step 2 = sort the left,middle and right elements of the segment }
  67.        IF (A[left] > middle) THEN { swap them! }
  68.         BEGIN
  69.          A[mid_index]    := A[left];
  70.              A[left]     := middle;
  71.              middle := A[mid_index]
  72.         END;
  73.        IF (A[right] < middle) THEN { swap them,then see if left element... }
  74.        BEGIN
  75.           A[mid_index]    := A[right];
  76.               A[right]     := middle;
  77.               middle := A[mid_index];
  78.           IF (A[left] > middle) THEN { ..left needs swapping again!}
  79.         BEGIN
  80.           A[mid_index]    := A[left];
  81.                   A[left]     := middle;
  82.                   middle := A[mid_index]
  83.         END;
  84.         END; { of : if A[right] < middle }
  85.       { now the middle value is the median of left,middle and right values }
  86.     past_midpoint := FALSE;
  87.     REPEAT
  88.       { step 3 = starting @ the rightmost  end seek a value
  89.                  less than that of the middle element }
  90.       REPEAT
  91.         newleft := newleft - 1;
  92.       UNTIL A[newleft] <= middle;
  93.           {and from the left seek a value greater than the middle}
  94.       REPEAT
  95.           newright := newright + 1;
  96.       UNTIL A[newright] >= middle;
  97.       IF (newright <= newleft) THEN { the found values are in the wrong }
  98.           BEGIN                     { halves  so swap them!  }
  99.             tempvar     := A[newleft];
  100.                 A[newleft]  := A[newright];
  101.                 A[newright] := tempvar;
  102.           END ELSE past_midpoint := TRUE;
  103.          { when you pass the middle you have separated all elements 
  104.            > middle to the right and all those < middle to the left. }
  105.     UNTIL past_midpoint;
  106.       IF (newleft-left) > (right-newright) THEN { keep the smaller half }
  107.         BEGIN                               { and stack the larger. }
  108.             left_bound[pointer]   := left;
  109.             right_bound[pointer]  := newleft;
  110.             left           := newright
  111.             END ELSE BEGIN
  112.             left_bound[pointer]   := newright;
  113.             right_bound[pointer]  := right;
  114.             right             := newleft
  115.             END;
  116.        pointer := pointer + 1;
  117.        END ELSE BEGIN { For each segment with < 11 members ( except the
  118.             initial segment ) sort using a straight "sinking"
  119.             insertion sort , by interchange of adjacent pairs.}
  120.      FOR element := (left+1) TO right DO
  121.        BEGIN
  122.          middle   := A[element];
  123.          newright := element - 1;
  124.          IF A[newright] > middle THEN
  125.            BEGIN
  126.                  REPEAT
  127.                    A[newright+1] := A[newright];
  128.                    newright      := newright - 1;
  129.                  UNTIL A[newright] <= middle;
  130.                  A[newright+1]   := middle;
  131.            END;
  132.        END; { of : For element := (left + 1) ...}
  133.      pointer := pointer - 1;
  134.      IF pointer >= 0 THEN
  135.        BEGIN
  136.          left  := left_bound[pointer];
  137.          right := right_bound[pointer];
  138.        END ELSE alldone := TRUE;
  139.        END;      { of : outermost if-then-else block }
  140.   UNTIL alldone; { end of outermost repeat loop }
  141.  END;            { of : if ok_array                  }
  142.  qqsort_real := ok_array;
  143. END;             { of : function qqsort_real }    {$C+,M+,F+}
  144.  
  145.