a_pq.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


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

class A_PQ{ETP < $IS_LT{ETP}} < $PQ{ETP} is -- This class is an array-based implementation of a priority queue. -- Retrieval order is based on the highest weight/priority. This is -- determined by an external auxiliary class which permits weight changing -- without exhaustive search of the queue entries. -- Usage: -- -- queue : PQ{INT} := PQ{INT}::create(ARRAY{INT}::create(|2,3,4,5|)) ; -- #OUT + queue.pop + "," + queue.pop + "," + queue.pop ; -- -- prints 5,4,3 -- -- wrap : PQMIN{INT} ; -- Used as a class alias -- queue : PQ{PQMIN{INT}} := PQ{PQMIN{INT}}::create( -- |wrap.create(2),wrap.create(4),wrap.create(3)|) ; -- #OUT + queue.pop + "," + queue.pop + "," + queue.pop ; -- -- prints 2,3,4 -- -- wrap : PQWT{STR,INT} ; -- queue : PQ{PQWT{STR,INT}} := PQ{PQWT{STR,INT}}::create( -- |wrap.create("a",1),wrap.create("b",2)|) ; -- #OUT + queue.pop + "," + queue.pop ; -- -- prints "(b,2) (a,1)" -- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Jul 96 bg Original -- 13 Mar 97 kh Adapted to use CARD -- 10 Nov 98 kh revised, added pre/post conditions. private include COMPARE{ETP} ; include ELT_FILTERS{ETP} ; include CONTAINER_STR{ETP} ; private attr arr : ARRAY{ETP} ; readonly attr size : CARD ; -- Bottom of queue create : SAME is -- This routine returns a new empty priority queue. me : SAME := new ; me.arr := ARRAY{ETP}::create(2) ; -- first element goes into [1] me.size := 0 ; return me end ; create_sized( cnt : CARD ) : SAME pre cnt >= 1 post ~void(result) is -- This routine returns an empty new priority queue capable of holding -- cnt elements. me : SAME := new ; me.arr := ARRAY{ETP}::create(cnt + 1) ; me.size := 0 ; return me end ; create( arr : $ELT{ETP} ) : SAME is -- This routine returns a new priority queue containing the entries -- from arr. me : SAME := SAME::create ; loop me.insert(arr.elt!) end ; return me end ; create_from( arr : ARRAY{ETP} ) : SAME is -- This routine permits use of literal syntax when creating a queue -- using type inference. return SAME::create(arr) end ; copy : SAME pre ~void(self) post true -- (result = self) is -- This routine returns a new copy of self. res : SAME := new ; res.arr := arr.copy ; res.size := size ; return res end ; is_empty : BOOL is -- This predicate returns true if and only if the queue is empty. return (size = 0) end ; contains( elem : ETP ) : BOOL is -- This predicate returns true if and only if there is an entry elem. index : CARD := 1 ; loop until!(index > size) ; if elt_eq(elem,arr[index]) then return true end ; index := index + 1 end ; return false end ; check_heap : BOOL is -- This predicate returns true if and only if self is a legal heap for -- a queue. index : CARD := 1 ; loop until!(index > size) ; if (2 * index) <= size then if arr[index] < arr[2 * index] then return false end end ; if (2 * index + 1) <= size then if arr[index] < arr[2 * index + 1] then return false end end ; index := index + 1 end ; return true end ; top : ETP pre ~is_empty post (result = arr[1]) is -- This routine returns the front element in the queue or void if empty. return arr[1] end ; current : ETP pre ~is_empty post (result = arr[1]) is -- This routine is a synonym for top. return top end ; array : ARRAY{ETP} pre ~void(self) post (result.size = size) is -- This routine returns the contents of the queue as a one-dimensional -- array. res : ARRAY{ETP} := ARRAY{ETP}::create(size) ; loop res.set!(elt!) end ; return res end ; clear pre ~void(self) post is_empty is -- This routine discards the entire queue, leaving the garbage collector -- to reclaim storage. arr.clear ; size := 0 end ; private sift_up( lower, upper : CARD ) pre (lower >= 1) and (upper >= 1) and (lower <= upper) and (upper < arr.size) post true is -- This routine changes the queue from the index range lower to upper - 1 -- into one with the range lower to upper. index : CARD := upper ; loop until!(index <= lower ) ; outdex : CARD := index / 2 ; if arr[index] < arr[outdex] then break! else -- swap contents of elements temp : ETP := arr[outdex] ; arr[outdex] := arr[index] ; arr[index] := temp; index := outdex end end end ; private sift_down( lower, upper : CARD ) pre (lower >= 0) and (upper >= 0) and (upper < arr.size) post true is -- This private routine contracts the heap in the range lower + 1 to -- upper to be in the range lower to upper. index : CARD := lower ; loop outdex : CARD := 2 * index ; if outdex > upper then -- larger sibling break! end ; if 1 + outdex <= upper and (arr[outdex] < arr[outdex + 1]) then outdex := outdex + 1 end ; if ~(arr[index] < arr[outdex]) then break! else -- swap elements temp : ETP := arr[outdex] ; arr[outdex] := arr[index] ; arr[index] := temp ; index := outdex end end end ; delete( elem : ETP ) : ETP pre ~void(self) post (result = elem) or void(result) is -- This routine removes the indicated element from the queue and returns -- it if found, otherwise it returns void. loc_element : ETP := void ; index : CARD := 1 ; loop until!(index > size) ; if elt_eq(elem,arr[index]) then loc_element := arr[index] ; arr[index] := arr[size] ; arr[size] := void ; size := size - 1 ; sift_down(index,size) ; return loc_element end ; index := index + 1 end ; return loc_element end ; pop : ETP pre ~is_empty post true is -- This routine returns void if the queue is empty, otherwise removes -- the item from the queue and returns it. res : ETP := arr[1] ; arr[1] := arr[size] ; arr[size] := void ; -- for garbage collection! size := size - 1 ; sift_down(1,size) ; -- fix up queue return res end ; remove : ETP pre ~is_empty post true is -- This routine is a synonym for pop! return pop end ; insert( elem : ETP ) pre ~void(self) post contains(elem) is -- This routine inserts elem into the queue. If the queue is full then -- it is doubled in size, copying from the original. if size >= arr.asize - 2 then -- resize if area full new_arr : ARRAY{ETP} := ARRAY{ETP}::create(2 * arr.asize) ; loop new_arr.set!(arr.elt!) end ; arr := new_arr end ; size := size + 1 ; arr[size] := elem ; -- put new element at bottom sift_up(1,size) -- fix up the heap end ; insert( elem : ETP ) : SAME pre~void(self) post (result.arr[result.size] = elem) is -- This routine is a variant of insert which returns itself. insert(elem) ; return self end ; bounded_insert( elem : ETP, bound : CARD ) pre ~void(self) post (size <= bound) is -- This routine inserts the given element and then pops the queue until -- no more than bound elements remain. insert(elem) ; loop until!(size <= bound) ; discard : ETP := pop end end ; pop! : ETP pre true post ~contains(result) is -- This iter yields all elements of the queue in priority order, -- emptying the queue. loop until!(is_empty) ; yield(pop) end end ; elt! : ETP pre ~void(self) post contains(result) is -- This routine yields the elements of the queue in an implementation- -- dependent order, NOT priority order! index : CARD := 1 ; loop until!(index > size) ; yield(arr[index]) ; index := index + 1 end end ; end ; -- A_PQ

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

immutable class PQMIN{ETP < $IS_LT{ETP}} < $IS_LT{PQMIN{ETP}} is -- This immutable class is a wrapper which inverts the behaviour of -- the less-than operator so that the priority ranking is from 1 upwards -- as opposed to max downwards. -- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Jul 96 bg Original -- 13 Mar 97 kh Adapted to use CARD -- 10 Nov 98 kh Refined, added pre/post conditions. include COMPARABLE ; attr element : ETP ; create( elem : ETP ) : SAME is -- This routine creates and returns a new member of the class. return element(elem) end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other are identical. return element = other.element end ; is_lt( other : SAME ) : BOOL is -- This predicate returns true if and only if self is greater than other! return element > other.element end ; str( elem : ETP, lib : LIBCHARS ) : STR pre ~void(lib) post ~void(result) is -- This routine returns a string representation of the element if that -- is possible, otherwise an asterisk. typecase elem when $STR then return elem.str(lib) else return lib.Asterisk.str end end ; str( elem : ETP ) : STR pre true post ~void(result) is -- This routine returns a string representation of the element using -- the current default repertoire and encoding, if that be possible, -- otherwise an empty string. return str(elem,LIBCHARS::default) end ; end ; -- PQMIN

class PQWT{ETP, WTP < $EXACT_NUMBER{WTP}} < $IS_LT{PQWT{ETP,WTP}}

class PQWT{ETP, WTP < $EXACT_NUMBER{WTP}} < $IS_LT{PQWT{ETP,WTP}} is -- This auxiliary class is a wrapper for the kind of queue in which -- the weighting is different from the element value. -- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Jul 96 bg Original -- 13 Mar 97 kh Adapted to use CARD -- 10 Nov 98 kh Refined, added pre/post conditions. include COMPARABLE ; attr weight : WTP ; attr element : ETP ; create( node : ETP, weight : WTP ) : SAME is -- This routine creates a new element with the given value and weight. me : SAME := new ; me.weight := weight ; me.element :=node ; return me end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only iuf the weight of self and -- other are the same. return weight = other.weight end ; is_lt( other : SAME ) : BOOL is -- This predicate returns true if and only if the weight of self is less -- than the weight of other. return weight < other.weight end; str( lib : LIBCHARS ) : STR pre ~void(self) and ~void(lib) post ~void(result) is -- This routine returns a string representation of this element and -- weight using the current default encoding and repertoire. res : STR := lib.Left_Bracket.str + weight.str(lib) ; elem : E := element ; typecase elem when $STR then res := res + lib.Comma + elem.str(lib) else return lib.Asterisk.str end ; res := res + lib.Right_Bracket ; return res end ; str : STR pre ~void(self) post ~void(result) is -- This routine returns a string representation of this element and -- weight using the current default encoding and repertoire. return str(LIBCHARS::default) end ; end ; -- PQWT{ETP,WTP}

class PQMINWT{ETP, WTP < $EXACT_NUMBER{WTP}} <

class PQMINWT{ETP, WTP < $EXACT_NUMBER{WTP}} < $IS_LT{PQMINWT{ETP,WTP}}, $STR is -- This is an auxiliary wrapper class which provides for priority -- queues with separate weight value and inverted logic -- ie numerically -- lower weight encodings are considered to be of higher priority. -- Version 1.2 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Jul 96 bg Original -- 13 Mar 97 kh Adapted to use CARD -- 10 Nov 98 kh Refined, added pre/post conditions. include COMPARABLE ; attr weight : WTP ; attr element : ETP ; create( node : ETP, weight : WTP ) : SAME is -- This routine creates a new element with the given value and weight. me : SAME := new ; me.weight := weight ; me.element := node ; return me end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if the weights of other and -- self are the same. return weight = other.weight end ; is_lt( other : SAME ) : BOOL is -- This predicate returns true if and only if the weight of self is -- greater than the weight of other! return weight > other.weight end ; str( lib : LIBCHARS ) : STR pre ~void(self) and ~void(lib) post ~void(result) is -- This routine returns a text representation of self using the given -- repertoire and encoding. res : STR := lib.Left_Bracket.str + weight.str(lib) ; elem : ETP := element ; typecase elem when $STR then res := res + lib.Comma + elem.str(lib) else return lib.Asterisk.str end ; res := res + lib.Right_Bracket ; return res end ; str : STR pre ~void(self) post ~void(result) is -- This routine returns a string representation of self using the -- current default repertoire and encoding. return str(LIBCHARS::default) end ; end ; -- PQMINWT