Incidentally, in case it's not obvious, the problem was that I somehow confused myself into thinking that "PriorityQueue k" was a type, when it's really a relation on types; thus, what I really needed to write was "PriorityQueue q k | q -> k" and then just refer to the queue type as "q" in the class definition. Fixed code attached for reference (and this no longer triggers an ICE in ghc).
Daniel -- /------------------- Daniel Burrows <[EMAIL PROTECTED]> ------------------\ | "What is your age? | | Enter 98 for 'don't know', 99 for 'no answer'." | | -- Penn State student survey | \---------------- The Turtle Moves! -- http://www.lspace.org ---------------/
{-# OPTIONS_GHC -fglasgow-exts #-}
module PriorityQueue(
Heap,
PriorityQueue(..)
) where
import qualified Data.Set as Set
-- Implements Ye Olde Priority Queue. You probably want to import
-- this qualified.
-- A priority queue lets you create a set of objects and extract
-- the minimum element at any time.
class (Ord k) => PriorityQueue q k | q -> k where
empty :: q
null :: q -> Bool
insert :: k -> q -> q
-- Return the least queue element:
getMin :: q -> k
-- Remove and discard the least queue element:
pop :: q -> q
-- Remove the least queue element and return it:
dequeue :: q -> (k, q)
dequeue pq = (getMin pq, pop pq)
contents :: q -> [k]
contents pq = if (PriorityQueue.null pq) then []
else k:(contents pq') where (k, pq') = dequeue pq
instance (Ord k) => PriorityQueue (Set.Set k) k where
empty = Set.empty
null = Set.null
insert = Set.insert
getMin = Set.findMin
pop = Set.deleteMin
dequeue = Set.deleteFindMin
contents = Set.toAscList
-- NB: should I use Int instead of Integer?
data (Ord k) => Heap k = EmptyHeap |
Heap {size :: !Integer,
key :: k,
left, right :: (Heap k)}
instance (Ord k) => PriorityQueue (Heap k) k where
empty = EmptyHeap
null EmptyHeap = True
null _ = False
insert = insertHeap
getMin = minHeap
pop = popHeap
heapSize :: (Ord k) => Heap k -> Integer
heapSize EmptyHeap = 0
heapSize Heap {size = s} = s
insertHeap :: (Ord k) => k -> Heap k -> Heap k
insertHeap k EmptyHeap = Heap 0 k EmptyHeap EmptyHeap
insertHeap k h@(Heap {key = k', size = s, left = h1', right = h2'}) =
if heapSize h1' < heapSize h2' then
Heap {key = minK, size = s+1, left = (recur h1'), right = h2'}
else
Heap {key = minK, size = s+1, left = h1', right = (recur h2')}
where recur h' = insertHeap maxK h'
minK = min k k'
maxK = max k k'
-- Empty heaps have no minimum (it's an error to even try to find one)
minHeap :: (Ord k) => Heap k -> k
minHeap (Heap {key = k}) = k
-- Note that this may unbalance the heap...but if you work out some
-- cases you'll see that the worst-case depth is still logarithmic in
-- the total number of operations, and that moreover if you are hit
-- with the worst-case cost, you always decrease the "badness" of the
-- tree. Another way of looking at it is that trying to rebalance the
-- tree up-front would (I believe) incur about as much cost as just
-- accepting that the tree might become temporarily unbalanced.
-- The key to the comment above is the observation that the tree never
-- increases in depth unless it is fully balanced...so if you have an
-- unbalanced tree and hit the worst-case, it must be because you
-- deleted an element on the longest path in the tree. Think
-- amortized analysis.
popHeap :: (Ord k) => Heap k -> Heap k
popHeap Heap {left = EmptyHeap, right = h'} = h'
popHeap Heap {right = EmptyHeap, left = h'} = h'
popHeap [EMAIL PROTECTED] {left = [EMAIL PROTECTED] {key = lk}, right = [EMAIL PROTECTED] {key = rk}} =
if lk < rk then
h {key = lk, size = (size h)-1, left=popHeap l}
else
h {key = rk, size = (size h)-1, right=popHeap r}
pgpgK6RBdL9F9.pgp
Description: PGP signature
