home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / ARRAY.SA < prev    next >
Text File  |  1995-02-05  |  24KB  |  582 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. -- array.sa: One-dimensional arrays, including sorting, searching, etc.
  9.  
  10. -------------------------------------------------------------------
  11. class ARRAY{T} is
  12.    -- One-dimensional arrays of elements of type T, including sorting, 
  13.    -- searching, etc. Array indices start at 0 and go to `asize-1'. 
  14.    -- Most features here work when self is void. The intent is that
  15.    -- a void array behave just like a zero-sized array. Thus self may 
  16.    -- be void on operations which don't try to directly access specific 
  17.    -- elements since any such access would be out of range.
  18.    
  19.    private include AREF{T} 
  20.       aget->aget, aset->aset, asize->asize; -- Make these public.
  21.      -- Note that self may not be void for these.
  22.          
  23.    elt_eq(e1,e2:T):BOOL is
  24.       -- The test for element equality used by the following routines.
  25.       -- Uses object equality by default. May be redefined in 
  26.       -- descendants.
  27.       typecase e1
  28.       when $IS_EQ{T} then return e1.is_eq(e2)
  29. --    else return SYS::ob_eq(e1,e2) end end;                                    -- NLP
  30.       else; end; return SYS::ob_eq(e1,e2); end;                                 -- NLP
  31.  
  32.    elt_hash(e:T):INT is
  33.       -- A hash value associated with an element. Must have the property
  34.       -- that if "elt_eq(e1,e2)" then "elt_hash(e1)=elt_hash(e2)". Can
  35.       -- be defined to always return 0, but many routines will then
  36.       -- become quadratic. Uses object "id" by default.
  37.       -- May be redefined in descendants.
  38.       typecase e
  39.       when $HASH then return e.hash
  40. --    else return SYS::id(e) end end;                                           -- NLP
  41.       else; end; return SYS::id(e); end;                                        -- NLP
  42.  
  43.    elt_lt(e1,e2:T):BOOL is
  44.       -- The "less than" relation used in the sorting routines. Compares
  45.       -- the object "id" by default. May be redefined in descendants.
  46.       typecase e1
  47.       when $IS_LT{T} then return e1.is_lt(e2)
  48. --    else return SYS::id(e1) < SYS::id(e2) end end;                            -- NLP
  49.       else; end; return SYS::id(e1) < SYS::id(e2); end;                         -- NLP
  50.    
  51.    size:INT is            
  52.       -- The number of elements in the array. Self may be void.
  53. --    if void(self) then return 0 else return asize end end;                    -- NLP
  54.       if void(self) then return 0; end; return asize; end;                      -- NLP
  55.    
  56.    create(n:INT):SAME
  57.       -- Create a new array of size `n' all of whose elements are void.
  58.       pre n>=0 is 
  59.       return new(n) end;
  60.    
  61.    clear is
  62.       -- Set each array element to void. Built-in. Self may be void.
  63.       if ~void(self) then aclear end end;
  64.    
  65.    elt!:T is
  66.       -- Yield each element of self in order. Self may be void.
  67.       if ~void(self) then loop yield aelt! end end end;
  68.  
  69.    elt!(beg:INT):T 
  70.       -- Yield each element of self starting at `beg'. Self may 
  71.       -- not be void.
  72.       pre ~void(self) and beg.is_bet(0,asize-1) is      
  73.       loop yield aelt!(beg) end end;
  74.    
  75.    elt!(beg,num:INT):T
  76.       -- Yield `num' successive elements of self starting at
  77.       -- index `beg'. Self may not be void.
  78.       pre ~void(self) and beg.is_bet(0,size-1) and 
  79.           num.is_bet(0,size-beg) is
  80.       loop yield aelt!(beg,num) end end;      
  81.    
  82.    elt!(beg,num,step:INT):T
  83.       -- Yield `num' elements of self starting at `beg' and stepping
  84.       -- by `step' which must not be zero. Self may not be void.
  85.       pre ~void(self) and is_legal_aelts_arg(beg,num,step) is
  86.       loop yield aelt!(beg,num,step) end end;            
  87.    
  88.    set!(val:T!) is
  89.       -- Set successive elements of self to the values of `val'.       
  90.       -- Self may be void.
  91.       if ~void(self) then 
  92.      loop aset!(val); yield end end end;      
  93.  
  94.    set!(beg:INT,val:T!) 
  95.       -- Set successive elements starting at `beg' to the values of
  96.       -- `val'. Self may not be void.
  97.       pre ~void(self) and beg.is_bet(0,size-1) is
  98.       loop aset!(beg,val); yield end end;
  99.    
  100.    set!(beg,num:INT,val:T!) 
  101.       -- Set `num' successive elements of self starting at `beg'
  102.       -- to the values of `val'. Self may not be void.
  103.       pre ~void(self) and  beg.is_bet(0,size-1) and 
  104.           num.is_bet(0,size-beg) is
  105.       loop aset!(beg,num,val); yield end end;
  106.       
  107.    set!(beg,num,step:INT,val:T!)
  108.       -- Set `num' elements of self starting at `beg' stepping 
  109.       -- by `step' to the values of val. `step' must not be zero. 
  110.       -- Self may not be void.
  111.       pre ~void(self) and is_legal_aelts_arg(beg,num,step) is
  112.       loop aset!(beg,num,step,val); yield end end;
  113.  
  114.    resize(n:INT):SAME 
  115.       -- Allocate a new array and copy whatever will fit of the
  116.       -- old portion.  Returns the new array.
  117.       pre ~void(self) is
  118.          res::=#SAME(n);
  119.      loop res.set!(elt!); end;
  120.          return res;
  121.      end;
  122.  
  123.    copy:SAME is
  124.       -- A copy of self.
  125.       r::=create(size); r.copy(self); return r end;
  126.    
  127.    copy(src:SAME) is
  128.       -- Copy as many elements from `src' to self as will fit.
  129.       -- Both self and `src' may be void.
  130.       if ~void(self) and ~void(src) then acopy(src) end end;
  131.    
  132.    copy(beg:INT,src:SAME)
  133.       -- Copy as many elements from `src' to self as will fit when
  134.       -- starting at index `beg' of self. Self may not be void but
  135.       -- `src' may be void.
  136.       pre ~void(self) and (beg.is_bet(0,size-1) or src.size=0) is
  137.       if ~void(src) then acopy(beg,src) end end;
  138.    
  139.    copy(beg,num:INT, src:SAME) 
  140.       -- Copy `num' elements from `src' to self starting at index
  141.       -- `beg' of self. Neither self nor `src' may be void.
  142.       pre ~void(self) and ~void(src) and beg.is_bet(0,size-1) and 
  143.           num.is_bet(0,size-beg) and num<=src.size is
  144.       acopy(beg,num,src) end;
  145.    
  146.    copy(beg,num,srcbeg:INT,src:SAME) 
  147.       -- Copy `num' elements from `src' to self starting at index
  148.       -- `beg' of self and index `srcbeg' of `src'. Meither self nor 
  149.       -- `src' may be void.
  150.       pre ~void(self) and ~void(src) and beg.is_bet(0,size-1) and 
  151.           num.is_bet(0,size-beg) and num<=src.size-srcbeg is   
  152.       acopy(beg,num,srcbeg,src) end;      
  153.    
  154.    ind!:INT is
  155.       -- Yield the indices of self in order. Self may be void.
  156.       if ~void(self) then loop yield aind! end end end;
  157.    
  158.    subarr(beg,num:INT):SAME 
  159.       -- A new array with `num' entries copied from self 
  160.       -- starting at `beg'. Self may not be void.
  161.       pre ~void(self) and beg.is_bet(0,size-1) and 
  162.           num.is_bet(0,size-beg) is
  163.       r::=new(num); r.copy(0,num,beg,self); return r end;
  164.  
  165.    to_reverse is
  166.       -- Reverse the order of the elements in self. Self may be 
  167.       -- void.
  168.       if ~void(self) then
  169.      loop i::=(size/2).times!; 
  170.         u::=size-i-1; t::=[i]; [i]:=[u]; [u]:=t end end end;
  171.    
  172.    reverse:SAME is
  173.       -- A copy of self with the elements in reverse order.
  174.       -- Self may be void.
  175.       if void(self) then return void
  176. --    else r::=new(size);                                                       -- NLP
  177.       end; r::=new(size);                                                       -- NLP
  178.      loop r.set!(asize-1, asize, -1, elt!) end;
  179. --       return r end end;                                                      -- NLP
  180.          return r; end;                                                         -- NLP
  181.  
  182.    to(src:SAME) 
  183.       -- Make self be a copy of `src'. Both may be void.
  184.       pre src.size=size is 
  185.       loop set!(src.elt!) end end;
  186.  
  187.    to_val(v:T) is
  188.       -- Set each element of self to `v'. Self may be void.
  189.       loop set!(v) end end;      
  190.  
  191.    append(a:SAME):SAME is
  192.       -- A new array consisting of self followed by `a'. Both may be void.
  193.       if void(self) then return a.copy
  194.       elsif void(a) then return copy
  195. --    else r::=new(size+a.size); r.copy(self); r.copy(size,a);                  -- NLP
  196.       end; r::=new(size+a.size); r.copy(self); r.copy(size,a);                  -- NLP
  197. --       return r end end;                                                      -- NLP
  198.          return r; end;                                                         -- NLP
  199.  
  200.    append(a1,a2:SAME):SAME is
  201.       -- A new array consisting of self followed by `a1' and `a2'. 
  202.       -- More efficient than two appends. Any of the arrays may be void.
  203.       if void(self) then return a1.append(a2)
  204.       elsif void(a1) then return append(a2)
  205.       elsif void(a2) then return append(a1)
  206. --    else r::=new(size+a1.size+a2.size);                                       -- NLP
  207.       end; r::=new(size+a1.size+a2.size);                                       -- NLP
  208.      r.copy(self); r.copy(size,a1); r.copy(size+a1.size,a2); 
  209. --       return r end end;                                                      -- NLP
  210.          return r; end;                                                         -- NLP
  211.  
  212.    append(a1,a2,a3:SAME):SAME is
  213.       -- A new array consisting of self followed by `a1', `a2' 
  214.       -- and `a3'. More efficient than three appends. Any of them may
  215.       -- be void.
  216.       if void(self) then return a1.append(a2,a3)
  217.       elsif void(a1) then return append(a2,a3)
  218.       elsif void(a2) then return append(a1,a3)
  219.       elsif void(a3) then return append(a1,a2)
  220. --    else r::=new(size+a1.size+a2.size+a3.size);                               -- NLP
  221.       end; r::=new(size+a1.size+a2.size+a3.size);                               -- NLP
  222.      r.copy(self); r.copy(size,a1); r.copy(size+a1.size,a2);
  223. --       r.copy(size+a1.size+a2.size,a3); return r end end;                     -- NLP
  224.          r.copy(size+a1.size+a2.size,a3); return r; end;                        -- NLP
  225.       
  226.    some(test:ROUT{T}:BOOL):BOOL is
  227.       -- True if some element of self satisfies `test'. 
  228.       -- Self may be void.
  229.       loop if test.call(elt!) then return true end end;
  230.       return false end;
  231.  
  232.    every(test:ROUT{T}:BOOL):BOOL is
  233.       -- True if every element of self satisfies `test'.
  234.       -- Self may be void.
  235.       loop if ~test.call(elt!) then return false end end; 
  236.       return true end;
  237.  
  238.    notany(test:ROUT{T}:BOOL):BOOL is
  239.       -- True if none of the elements of self satisfies `test'.
  240.       -- Self may be void.
  241.       loop if test.call(elt!) then return false end end; 
  242.       return true end;
  243.    
  244.    notevery(test:ROUT{T}:BOOL):BOOL is
  245.       -- True if not every element of self satisfies `test'.
  246.       -- Self may be void.
  247.       loop if ~test.call(elt!) then return true end end;
  248.       return false end;
  249.  
  250.    contains(e:T):BOOL is
  251.       -- True if the self has an element which is `elt_eq' to `e'.
  252.       if void(self) then return false end;
  253.       loop if elt_eq(elt!,e) then return true end end;
  254.       return false end;
  255.    
  256.    index_of(e:T):INT is
  257.       -- Return the index of the leftmost element which is `elt_eq' 
  258.       -- to `e' or -1 if there is none. Self may be void.
  259.       loop r::=ind!; if elt_eq(e,[r]) then return r end end; 
  260.       return -1 end;
  261.    
  262.    remove(e:T):SAME is
  263.       -- A new array without the elements which are `elt_eq' to `e'.
  264.       -- Self may be void.
  265.       if void(self) then return void 
  266. --    else r::=create(size-count(e));                                           -- NLP
  267.       end; r::=create(size-count(e));                                           -- NLP
  268.      loop se::=elt!; if ~elt_eq(se,e) then r.set!(se) end end;
  269. --       return r end end;                                                      -- NLP
  270.          return r; end;                                                         -- NLP
  271.       
  272.    remove_if(test:ROUT{T}:BOOL):SAME is
  273.       -- A new array without the elements that satisfy `test'.
  274.       -- Self may be void.
  275.       if void(self) then return void 
  276. --    else r::=create(count_if(test));                                          -- NLP
  277.       end; r::=create(count_if(test));                                          -- NLP
  278.      loop e::=elt!; if ~test.call(e) then r.set!(e) end end;
  279. --       return r end end;                                                      -- NLP
  280.          return r; end;                                                         -- NLP
  281.       
  282.    remove_duplicates:SAME is
  283.       -- A new array with only the first copy of duplicated elements.
  284.       -- "elt_eq" is used to say when elements are duplicate. The
  285.       -- order of the retained items is preserved. Self may be void.
  286.       return self end; -- *** for now
  287. --      if void(self) then return void end;
  288. --      ht::=IND_HASH::create(size); 
  289. --      al::=FLIST{INT}::create(size);
  290. --      loop i::=ind!; e::=[i]; h::=elt_hash(e); old::=false;
  291. --     loop 
  292. --        if elt_eq(e,[ht.bucket(h)]) then 
  293. --           old:=true; break! end end;
  294. --     if ~old then 
  295. --        ht.insert(i,h); al:=al.push(i) end end;
  296. --      r::=create(al.size); 
  297. --      loop r.set!([al.elt!]) end;
  298. --      ht.destroy; al.destroy; return r end;
  299.    
  300.    to_replace(o,n:T) is
  301.       -- Replace elements that are `elt_eq' to `o' by `n' where ever it 
  302.       -- occurs. Self may be void.
  303.       loop e::=elt!; 
  304.      if elt_eq(e,o) then e:=n end; 
  305.      set!(e) end end;
  306.  
  307.    to_replace_if(test:ROUT{T}:BOOL, n:T) is
  308.       -- Replace elements that satisfy `test' by `n'.
  309.       -- Self may be void.
  310.       loop e::=elt!; 
  311.      if test.call(e) then e:=n end; 
  312.      set!(e) end end;
  313.  
  314.    find_if(test:ROUT{T}:BOOL):T is
  315.       -- Return leftmost element of self which satisfies `test', 
  316.       -- or void if there is none. Self may be void.
  317.       loop r::=elt!; if test.call(r) then return r end end; 
  318.       return void end;
  319.  
  320.    index_if(test:ROUT{T}:BOOL):INT is
  321.       -- Return the index of the leftmost element that satisfies `test', 
  322.       -- or -1 if there is none. Self may be void.
  323.       loop r::=ind!; if test.call([r]) then return r end end; 
  324.       return -1 end;
  325.  
  326.    count(v:T):INT is
  327.       -- The number of elements that are `elt_eq' to `v'.
  328.       -- Self may be void.
  329.       r::=0; loop if elt_eq(elt!,v) then r:=r+1 end end;
  330.       return r end;
  331.       
  332.    count_if(test:ROUT{T}:BOOL):INT is
  333.       -- The number of elements which satisfy `test'.
  334.       -- Self may be void.
  335.       r::=0; loop if test.call(elt!) then r:=r+1 end end;
  336.       return r end;
  337.  
  338.    mismatch(a:SAME):INT is
  339.       -- The index of the first element of self which differs from 
  340.       -- `a'. -1 if self is a prefix of `a' or self is void.
  341.       if void(self) then return -1 end;
  342.       loop r::=ind!; if ~elt_eq([r],a.elt!) then return r end end;
  343.       return -1 end;
  344.  
  345.    search(a:SAME):INT is
  346.       -- The index of the leftmost subarray of self which matches `a'.
  347.       -- -1 if none or self is void. Uses simple algorithm which has 
  348.       -- good performance unless the arrays are special (eg. many 
  349.       -- repeated values).
  350.       if void(self) then return -1 end;
  351.       loop r::=0.upto!(size-a.size); 
  352.      match::=true;
  353.      loop if ~elt_eq(elt!(r),a.elt!) then match:=false; break! end end;
  354.      if match=true then return r end end; 
  355.       return -1 end;
  356.  
  357.    search(beg:INT,a:SAME):INT 
  358.       -- The index of the leftmost subarray of self starting at `beg' or
  359.       -- beyond, which matches `a'. -1 if none. Uses simple algorithm 
  360.       -- which has good performance unless the arrays are special (eg. 
  361.       -- many repeated values).
  362.       pre ~void(self) and beg.is_bet(0,asize-1) is
  363.       loop r::=beg.upto!(size-a.size); 
  364.      match::=true;
  365.      loop if ~elt_eq(elt!(r),a.elt!) then match:=false; break! end end;
  366.      if match=true then return r end end; 
  367.       return -1 end;
  368.  
  369.    map(r:ROUT{T}:T) is
  370.       -- Set each element of self to the result of applying `r' to it.
  371.       -- Self may be void.
  372.       loop set!(r.call(elt!)) end end;
  373.    
  374.    reduce(r:ROUT{T,T}:T):T is
  375.       -- Combine all the elements of self by applying `r' from 
  376.       -- low indices to high. Void if self is void or size=0.
  377.       if size=0 then return void end; 
  378.       v::=[0]; loop v:=r.call(v,elt!(1,size-1)) end; return v end;
  379.  
  380.    scan(r:ROUT{T,T}:T) is
  381.       -- Set each element in self to the result of applying `r' left to
  382.       -- right to the array up to the element. The first element is left
  383.       -- unchanged. Self may be void.
  384.       if ~void(self) then
  385.      loop i::=1.upto!(size-1); [i]:=r.call([i-1],[i]) end end end; 
  386.    
  387. -- Routines relating to sorted arrays:   
  388.    
  389.    is_sorted:BOOL is 
  390.       -- True if the elements of self are in sorted order according
  391.       -- to `elt_lt'. Self may be void.
  392.       if ~void(self) then
  393.          loop i::=1.upto!(asize-1);
  394.             if elt_lt([i],[i-1]) then return false end end end;
  395.       return true end;
  396.    
  397.    -- SOMEBODY TAKE A CLOSE LOOK AT THIS TO SEE IF THERE MIGHT
  398.    -- BE A MORE EFFICIENT WAY TO CODE IT.
  399.    insertion_sort_range(l,u:INT)
  400.       -- Stably sort the elements of self between `l' and `u'
  401.       -- inclusive by insertion sort. `elt_lt' defines the ordering.
  402.       pre ~void(self) and l.is_bet(0,asize-1) and u.is_bet(l,asize-1) is
  403.       loop
  404.          i::=(l+1).upto!(u); e::=[i];
  405.          loop
  406.             j::=(i - 1).downto!(l-1);
  407.             if (j < l) then [l]:=e; break!;
  408.             elsif (elt_lt([j], e)) then [j+1]:=e; break!;
  409.             else [j+1]:=[j];
  410.             end;
  411.          end;
  412.       end;
  413.    end;
  414.    
  415.    private const quicksort_limit:INT:=10; -- When to stop the
  416.       -- quicksort recursion and switch to insertion sort.
  417.    
  418.    quicksort_range(l,u:INT)
  419.       -- Use quicksort to sort the elements of self from `l' to `u'
  420.       -- inclusive according to `elt_lt'.
  421.       pre ~void(self) and l.is_bet(0,asize-1) and u.is_bet(l,asize-1) is
  422.       if u-l>quicksort_limit then
  423.          r::=RND::int(l,u); t::=[r]; [r]:=[l]; [l]:=t; m::=l;
  424.          loop i::=(l+1).upto!(u); 
  425.             if elt_lt([i],t) then m:=m+1; 
  426.                s::=[m]; [m]:=[i]; [i]:=s end end;
  427.          t:=[l]; [l]:=[m]; [m]:=t;
  428.          quicksort_range(l,m-1); quicksort_range(m+1,u);
  429.       else insertion_sort_range(l,u) end end;   
  430.    
  431.    sort
  432.       -- Use quicksort to permute the elements of self so that 
  433.       -- it is sorted with respect to `elt_lt'. Self may be void.
  434.       post is_sorted is
  435.       if ~void(self) then quicksort_range(0,asize-1) end end;
  436.  
  437.    stable_sort
  438.       -- Use insertion sort to permute the elements of self so that 
  439.       -- it is sorted with respect to `elt_lt'. Equal elements
  440.       -- retain their initial order. Self may be void.
  441.       post is_sorted is
  442.       if ~void(self) then insertion_sort_range(0,asize-1) end end;   
  443.  
  444.    binary_search(e:T):INT
  445.       -- Assuming self is sorted, return the index of the element 
  446.       -- preceding the first element greater than `e' according to
  447.       -- `elt_lt'. -1 if self is void or if all elements are 
  448.       -- greater than `e'. 
  449.       pre is_sorted is
  450.       if void(self) then return -1 end;
  451.       l::=0; u::=asize-1;
  452.       if ~elt_lt(e,[u]) then return u end;
  453.       if elt_lt(e,[l]) then return -1 end;
  454.      -- From now on [u] is always known to be greater than `e', and
  455.      -- [l] is not greater than `e'.
  456.       loop while!(u>l+1); j::=(u+l)/2;
  457.      if elt_lt(e,[j]) then u:=j else l:=j end end;
  458.       return l end;
  459.    
  460.    is_sorted_by(lt:ROUT{T,T}:BOOL):BOOL is 
  461.       -- True if the elements of self are in sorted order using
  462.       -- `t' to define "less than". Self may be void.
  463.       if ~void(self) then
  464.      loop i::=1.upto!(asize-1);
  465.         if lt.call([i],[i-1]) then return false end end end;
  466.       return true end;
  467.    
  468.    insertion_sort_by(lt:ROUT{T,T}:BOOL)
  469.       -- Stably sort the elements of self using `t' to define "less than". 
  470.       -- Self may be void.
  471.       post is_sorted_by(lt) is
  472.       if void(self) then return end;
  473.       loop
  474.          i::=1.upto!(asize-1); e::=[i];
  475.          loop
  476.             j::=(i - 1).downto!(-1);
  477.             if (j < 0) then [0]:=e; break!;
  478.             elsif (lt.call([j], e)) then [j+1]:=e; break!;
  479.             else [j+1]:=[j];
  480.             end;
  481.          end;
  482.       end;
  483.    end;
  484.  
  485.    binary_search_by(e:T, lt:ROUT{T,T}:BOOL):INT
  486.       -- Assuming self is sorted by `lt', return the index of the element 
  487.       -- preceding the first element greater than `e'. -1 if self is void 
  488.       -- or if all elements are greater than `e'. 
  489.       pre is_sorted_by(lt) is
  490.       if void(self) then return -1 end;
  491.       l::=0; u::=asize-1;
  492.       if ~lt.call(e,[u]) then return u end;
  493.       if lt.call(e,[l]) then return -1 end;
  494.      -- From now on [u] is always known to be greater than `e', and
  495.      -- [l] is not greater than `e'.
  496.       loop while!(u>l+1); 
  497.      j::=(u+l)/2;
  498.      if lt.call(e,[j]) then u:=j else l:=j end end;
  499.       return l end;
  500.    
  501.    merge_with_by(a:SAME, lt:ROUT{T,T}:BOOL):SAME
  502.       -- A new array with the elements of self and `a' merged together
  503.       -- according to `lt' which should return true if its first argument
  504.       -- is less than its second.
  505.       pre is_sorted_by(lt) and a.is_sorted_by(lt) 
  506.       post result.is_sorted_by(lt) is
  507.       if void(self) then return a.copy end;
  508.       if void(a) then return copy end;      
  509.       r::=create(size+a.size); i,j:INT; w:T;
  510.       loop 
  511.      if i=size then w:=a[j]; j:=j+1
  512.      elsif j=a.size then w:=[i]; i:=i+1
  513.      elsif lt.call([i],a[j]) then w:=[i]; i:=i+1
  514.          else w:=a[j]; j:=j+1 end; 
  515.      r.set!(w) end;
  516.       return r end;
  517.  
  518.    select(i:INT) is
  519.       -- Move the elements of self so that the element with index `i' is 
  520.       -- not `elt_lt' any element with lower indices and no element with
  521.       -- a larger index is `elt_lt' it.
  522.       l::=0; u::=size-1;
  523.       loop until!(l>=u);    -- [0->l-1] <= [l->u] <= [u+1->size-1]
  524.      r::=RND::int(l,u); 
  525.      t::=[r]; [r]:=[l]; [l]:=t; m::=l;     
  526.      loop j::=(l+1).upto!(u);
  527.         if elt_lt([i],t) then m:=m+1; 
  528.            t:=[m]; [m]:=[j]; [j]:=t end end;
  529.      t:=[l]; [l]:=[m]; [m]:=t; -- [l->m-1] <= [m] <= [m+1->u]
  530.      if m<=i then l:=m+1 end;
  531.      if m>=i then u:=m-1 end end end; 
  532.    
  533.    median:T is
  534.       -- The median of the elements contained in self according to the 
  535.       -- ordering relation `elt_lt'. Permutes the elements of self. Void 
  536.       -- if self is void.
  537.       if size=0 then return void end;
  538.       m::=size/2; select(m); return [m] end;
  539.    
  540.    select_by(lt:ROUT{T,T}:BOOL, i:INT) is
  541.       -- Move the elements of self so that the element with index `i' is 
  542.       -- not `lt' any element with lower indices and no element with
  543.       -- a larger index is `lt' it.
  544.       l::=0; u::=size-1;
  545.       loop until!(l>=u);    -- [0->l-1] <= [l->u] <= [u+1->size-1]
  546.      r::=RND::int(l,u); 
  547.      t::=[r]; [r]:=[l]; [l]:=t; m::=l;     
  548.      loop j::=(l+1).upto!(u);
  549.         if lt.call([j],t) then m:=m+1; 
  550.            t:=[m]; [m]:=[j]; [j]:=t end end;
  551.      t:=[l]; [l]:=[m]; [m]:=t; -- [l->m-1] <= [m] <= [m+1->u]     
  552.      if m<=i then l:=m+1 end;
  553.      if m>=i then u:=m-1 end end end;    
  554.    
  555. end; -- class ARRAY{T}   
  556.  
  557. -------------------------------------------------------------------   
  558.  
  559. class TEST_ARRAY is
  560.    -- Test of ARRAY{T}::insertion_sort_range and ::quicksort range.
  561.    include TEST;
  562.    main is
  563.       class_name("ARRAY{T}");
  564.  
  565.       a::=#ARRAY{FLTD}(20); fail::=0;
  566.       loop 100.times!; loop a.set!(RND::uniform) end;
  567.          a.insertion_sort_range(0,a.asize-1);
  568.          if ~a.is_sorted then fail:=fail+1 end end;
  569.       test("No. of times insertion_sort_range fails",fail.str,"0");
  570.  
  571.       b::=#ARRAY{FLTD}(50); fail:=0;
  572.       loop 100.times!; loop b.set!(RND::uniform) end;
  573.          b.quicksort_range(0,b.asize-1);
  574.          if ~b.is_sorted then fail:=fail+1 end end;
  575.       test("No. of times quicksort_range fails",fail.str,"0");
  576.  
  577.       finish;
  578.    end;
  579. end;
  580.  
  581.  
  582.