home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol131 / select.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  4.3 KB  |  131 lines
  1. FUNCTION select(VAR list : real_array;first,last,k : INTEGER) : BOOLEAN;
  2.  
  3. {$c-,m-,f-,r-  [turn off checking options for speed : select is debugged]}
  4. {
  5. Original Authors  : Robert W.Floyd,Stanford U.,Ca. &
  6.             Ronald L.Rivest,M.I.T.,Ma.
  7. Original language : Algol
  8. Reference      : Algorithm 489 Collected Algorithms A.C.M.
  9.  
  10. Modified 1982 for Pascal/z by G.M.Acland,U. of Penn.
  11.  
  12. Comment : Does a partial sort of the array list (using a partitioning technic
  13. similar to that used in QUICKSORT,QUICKERSORT etc.),such that :
  14.     1 : list[k] ends up containing the (k - first +1)th smallest value.
  15.     2 : all values for list[i] such that i =< k , will be =< list[k].
  16.         i.e. the left "half" of the array will contain only values
  17.         equal to or less than the (k - first + 1)th smallest.
  18.     3 : all values for list[i] such that i >= k , will be >= list[k].
  19.         i.e. the right "half" contains only values equal to or
  20.         greater than the (k - first + 1)th smallest.
  21.     The most frequent use for this type of procedure is in finding the
  22. median of an array.In this case one sets first = 1 , last = n , where n is the 
  23. order of the array,and k := (first+last)DIV 2 for n = ODD.Where n is even the
  24. median calculation is more complex.The FUNCTION median demonstrates this use.
  25.        If the function is called with ((last - first) < 1 ) , or if k is
  26. < first or > last , it returns FALSE.
  27. }
  28.  
  29. CONST
  30.     multiplier    = 0.1;
  31.     cutoff        = 100; { segment size below which the algorithm
  32.                  does not sample but only partitions. }
  33. VAR
  34.     left,right,
  35.     leftpart,
  36.     rightpart,
  37.     newleft,
  38.     newright    : INTEGER;
  39.     altleft,
  40.     altright,
  41.     leftside,
  42.     rightside,
  43.     samplesize,
  44.     listsize,
  45.     lnlistsize,
  46.         tempreal,
  47.     estimate,sd,
  48.     sd1,sd2        : REAL;
  49.     dummy        : BOOLEAN;
  50.  
  51. FUNCTION larger(a,b:INTEGER):INTEGER;
  52.  BEGIN
  53.   IF a > b THEN larger := a ELSE larger := b;
  54.  END;
  55.  
  56. FUNCTION smaller(a,b:INTEGER):INTEGER;
  57.  BEGIN
  58.   IF a < b THEN smaller := a ELSE smaller := b;
  59.  END;
  60.  
  61. PROCEDURE exchange(VAR a,b:REAL);
  62. VAR temp : REAL;
  63.  BEGIN
  64.   temp := a;
  65.   a    := b;
  66.   b    := temp;
  67.  END;
  68.  
  69. BEGIN { function SELECT }
  70.  IF ((last - first) < 1)
  71.  OR (k < first)
  72.  OR (k > last) THEN select:= FALSE
  73.  ELSE BEGIN
  74.    select := TRUE;
  75.    right := last;
  76.    left  := first;
  77.    WHILE right > left DO
  78.     BEGIN
  79.       IF (right - left) > cutoff THEN
  80.         BEGIN
  81.   
  82.         {comment : use SELECT recursively on a sample of size "samplesize"
  83.       to get an estimate of the (k - left + 1)th smallest element into
  84.       list[k],biased slightly so that the (k - left + 1)th element is
  85.       expected to lie in the smaller set after partitioning , and so
  86.       that this partition is kept as small as possible.}
  87.   
  88.           listsize   := right - left + 1;
  89.           leftside   := k - left + 1;
  90.           lnlistsize := LN(listsize);
  91.           samplesize := multiplier * EXP(2 * lnlistsize / 3);
  92.           sd1        := 2 * leftside/listsize - 1;
  93.           sd2        := sqrt(lnlistsize * samplesize 
  94.                                    * (listsize - samplesize)/listsize);
  95.           sd         := multiplier * sd2 * sd1;
  96.           tempreal   := samplesize/listsize;
  97.           altleft    := k - (leftside * tempreal) + sd;
  98.           newleft    := larger(left,ROUND(altleft));
  99.           altright   := k + ((listsize - leftside) * tempreal) + sd;
  100.           newright   := smaller(right,ROUND(altright));
  101.           dummy      := select(list,newleft,newright,k)
  102.         END;
  103.  
  104. {comment : the following code partitions list[left..right] about"estimate".}
  105.  
  106.       estimate  := list[k];
  107.       leftpart  := left;
  108.       rightpart := right;
  109.       exchange(list[left],list[k]);
  110.       IF list[right] > estimate THEN exchange(list[right],list[left]);
  111.       WHILE leftpart < rightpart DO
  112.         BEGIN
  113.          exchange(list[leftpart],list[rightpart]);
  114.          leftpart  := leftpart  + 1;
  115.          rightpart := rightpart - 1;
  116.          WHILE list[leftpart]  < estimate DO leftpart  := leftpart  + 1;
  117.          WHILE list[rightpart] > estimate DO rightpart := rightpart - 1;
  118.         END;
  119.       IF list[left] = estimate THEN exchange(list[left],list[rightpart])
  120.        ELSE BEGIN
  121.         rightpart := rightpart + 1;
  122.         exchange(list[rightpart],list[right])
  123.        END;
  124. {comment : now adjust left & right so they surround the subset containing
  125.        the (k - left + 1)th smallest element. }
  126.       IF rightpart <= K THEN left  := rightpart + 1;
  127.       IF k <= rightpart THEN right := rightpart - 1;
  128.     END;
  129.  END; { of : if n < 1 }
  130. END;  { of : function select }
  131.