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