a_pq.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
---------------------------> Sather 1.1 source file <--------------------------
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.


class A_PQ{T < $IS_LT{T}} < $PQ{T}

class A_PQ{T < $IS_LT{T}} < $PQ{T} is -- E is the element type. -- W is the weight type -- Priority queue implemented using an array based heap. Retrieves -- maximal elements first. -- -- Usage: -- a: PQ{INT} := #(#ARRAY{INT}(|2,3,4,5|)); -- #OUT+a.pop+","+a.pop+","+a.pop; -- prints 5,4,3 -- wrap: PQMIN{INT}; -- Used as a class alias for the create below -- a: PQ{PQMIN{INT}}:=#(|wrap.create(2),wrap.create(4),wrap.create(3)|); -- #OUT+a.pop+","+a.pop+","+a.pop; -- prints 1,3,4 -- wrap: PQWT{STR,INT}; -- a: PQ{PQWT{STR,INT}}:=#(wrap.create("a",1),wrap.create("b",2)|); -- #OUT+a.pop+","+a.pop+","+a.pop; -- prints "(b,2) (a,1)" -- -- Design note: It is better to provide access to weight changing -- methods via an auxilliary wrapper, since that permits external -- objects to change the weight without searching through all -- elements private include COMPARE{T}; private attr arr:ARRAY{T}; readonly attr size:INT; -- Bottom of queue, = number of elements. create:SAME is -- A new empty priority queue. res ::= new; res.arr:=#ARRAY{T}(2); -- The first element goes into [1] res.size := 0; return(res); end; -- create create_sized(n:INT):SAME pre n >= 1 is -- A new empty priority queue, initially sized to hold `n' elements. res::=new; res.arr:=#ARRAY{T}(n+1); res.size := 0; return(res); end; -- create_sized create(a: $ELT{T}): SAME is -- Return a new priority queue constructed out of the elements of -- "a" res ::= #SAME; loop res.insert(a.elt!) end; return res; end; create_from(a: ARRAY{T}): SAME is -- Permits use of the literal syntax using type inference return #SAME(a); end; is_empty:BOOL is -- True if queue is empty. return(size=0); end; -- is_empty current: T is return top end; top:T pre ~is_empty is return(arr[1]) end; -- Top element or `void' if empty. has(e: T): BOOL is -- Whether the queue has "e" i::=1; loop until!(i>size); if elt_eq(e,arr[i]) then return true; end; i := i+1; end; return false; end; delete(e:T): T is -- removes e from the heap if it is present and returns it -- otherwise returns void elm:T; i::=1; loop until!(i>size); if elt_eq(e, arr[i]) then elm:=arr[i]; arr[i] := arr[size]; arr[size] := void; size := size-1; sift_dn(i,size); return elm; end; i:=i+1; end; return elm; end; remove: T is return pop end; pop:T pre ~is_empty is -- Pops off the first element or `void' if empty. res::=arr[1]; arr[1]:=arr[size]; arr[size]:=void; -- forget so gc can get what was there size:=size-1; -- shrink queue sift_dn(1,size); -- fix up heap return(res); end; -- pop insert(e:T) is -- Insert `e' into priority queue. if size>=arr.asize-2 then -- resize if area full -- i.e. insert location(size+1) >= size of array(arr.asize-1) -- Since we start off with an array of size 0, need to add 2 below new_arr ::= #ARRAY{T}(2*arr.asize); loop new_arr.set!(arr.elt!) end; arr := new_arr; -- Should discard the old one -- arr:=arr.extend(2*arr.asize) end; size:=size+1; arr[size]:=e; -- put new element at bottom sift_up(1,size); -- fix up the heap end; -- insert insert(e: T): SAME is insert(e); return self end; bounded_insert(e: T, bnd: INT) is -- Insert "e", then keep popping until there are fewer than "bnd" -- elements left insert(e); loop until!(size <= bnd); discard ::= pop; end; end; pop!: T is -- Yield the elemnts of the queue in priority order, emptying the queue loop until!(is_empty); yield(pop); end; end; elt!: T is -- NOTE: In any order, NOT in priority order! -- That would be much more expensive, and is probably best done -- by popping elemetns off and then putting them in another queue. i::=1; loop until!(i>size); yield(arr[i]); i := i+1; end; end; clear is -- Clear the queue. arr.clear; size:=0; end; -- clear check_heap:BOOL is -- True if `self' is a legal heap. res::=true; i:INT:=1; loop until!(i>size); if 2*i<=size then if arr[i] < arr[2*i] then res:=false; break!; end; end; -- if if 2*i+1<=size then if arr[i] < arr[2*i+1] then res:=false; break!; end; end; -- if i:=i+1 end; -- loop return(res); end; -- check_heap private sift_up(l,u:INT) pre l>=1 and u>=1 and l<=u is -- Makes an `l,u' heap from a `l,u-1' heap in area. i:INT:=u; loop until!(i<=l); j:INT := i.rshift(1); if arr[i] < arr[j] then break!; else te:T:=arr[j]; arr[j]:=arr[i]; arr[i]:=te; -- swap i and j i := j end -- if end -- loop end; -- sift_up private sift_dn(l,u:INT) pre l>=0 and u>=0 is -- Make an `l,u' heap from an `l+1,u' heap in area. i:INT:=l; loop c:INT:= 2 * i; if c>u then break! end; -- bigger sib if 1+c<=u and (arr[c] < arr[c+1]) then c:=c+1 end; if ~(arr[i]<arr[c]) then break!; else te:T:=arr[c]; arr[c]:=arr[i]; arr[i]:=te; -- swap i and c i:=c end -- if end -- loop end; -- sift_dn str: STR is -- Prints out a string version of the flist of the components -- that are under $STR res ::= #FSTR(""); loop res := res+",".separate!(elt_str(elt!)); end; return(res.str); end; elt_str(e: T): STR is typecase e when $STR then return e.str else return "Unknown" end; end; copy: SAME is res ::= new; res.arr := arr.copy; res.size := size; return res; end; end; -- class PQ

immutable class PQMIN{T < $IS_LT{T}} < $IS_LT{PQMIN{T}}

immutable class PQMIN{T < $IS_LT{T}} < $IS_LT{PQMIN{T}} is -- Wrapper that inverts the < behavior, so that the priority queue -- will be sorted based on the > relationship i.e. minimal elements -- will be extracted first -- include COMPARABLE; attr element: T; create(e: T): SAME is return element(e); end; is_eq(e: SAME): BOOL is return element = e.element; end; is_lt(e:SAME):BOOL is -- Return true is self is GREATER than "e" i.e. invert the -- relationship return element > e.element; end; str(e: T): STR is typecase e when $STR then return e.str else return "Unknown" end; end; end;

class PQWT{E, WTP < $NUMBER{WTP}} < $IS_LT{PQWT{E,WTP}}

class PQWT{E, WTP < $NUMBER{WTP}} < $IS_LT{PQWT{E,WTP}} is -- A wrapper class for priority queue elements in which a weight -- (which is different from the element itself) is used -- -- Design note: This is not a immutable class since it is sometimes to -- be able to modify the weight of an inserted node without -- removing the element This would not be possible if the inserted -- element were a value type include COMPARABLE; attr weight:WTP; attr element: E; create(node:E,weight: WTP): SAME is res ::= new; res.weight := weight; res.element :=node; return res; end; is_lt(e: SAME):BOOL is return weight < e.weight end; is_eq(e: SAME): BOOL is return weight = e.weight end; str: STR is res ::= "("+weight.str; n: E := element; typecase n when $STR then res:=res+","+n.str; else return "Unknown" end; res := res+")"; return res; end; end;

class PQMINWT{E, WTP < $NUMBER{WTP}} < $IS_LT{PQMINWT{E,WTP}}, $STR

class PQMINWT{E, WTP < $NUMBER{WTP}} < $IS_LT{PQMINWT{E,WTP}}, $STR is -- A wrapper class for priority queue elements in which a weight -- (which is different from the element itself) is used In -- addition, the comparison function for the weight is reversed so -- that smaller weights are considered larger. Thus, minimum elements -- will be removed from the priority queue first include COMPARABLE; attr weight:WTP; attr element: E; create(node:E,weight: WTP): SAME is res ::= new; res.weight := weight; res.element :=node; return res; end; is_lt(e: SAME):BOOL is return weight > e.weight end; is_eq(e: SAME):BOOL is return weight = e.weight end; str: STR is res ::= "("+wtstr(weight); n: E := element; typecase n when $STR then res:=res+","+n.str; else return "Unknown" end; res := res+")"; return res; end; wtstr(w:WTP): STR is typecase w when $STR then return w.str else return "UnprintableWeight"; end end; end;