singleton priority queue


Write a singleton priority queue, a priority queue that suppresses duplicate elements.

 $ cat spq.rkt 
 #lang racket 
  
 (provide 
   spq-dq! 
   spq-empty? 
   spq-head 
   spq-new 
   spq-nq! 
   ) 
  
  
 (require "priority-queue.rkt") 
  
  
 #| An obvious implementation of a singleton priority queue, except 
    filtering is done on egress rather than ingress.  Egress filtering 
    uses no extra space (the queue is the filter), but dequeuing is now 
    O(n log n) (the size operation is also a mess). 
 |# 
  
 (define (spq-dq! spq) 
  
   ; Remove and return the head of the given singleton priority 
   ; queue, or die if there's no such element. 
    
   (let ((pq (cdr spq))) 
     (if (pq-empty? pq) 
       (raise-arguments-error 'spq-dq! 
          "Dequeuing from an empty singleton priority queue") 
       (let ((e (pq-dq! pq))) 
         (do () ((or (pq-empty? pq) (not (= (pq-top pq) e))) e) 
           (pq-dq! pq)))))) 
  
  
 (define (spq-empty? spq) 
  
   ; Return #t iff the given priority queue contains no elements. 
  
   (pq-empty? (cdr spq))) 
  
  
 (define (spq-head spq) 
  
   ; Return the head of the given priority queue; die 
   ; if there's no such element. 
    
   (let ((pq (cdr spq))) 
     (if (pq-empty? pq) 
       (raise-arguments-error 'spq-head 
          "Returning the head of an empty singleton priority queue") 
       (pq-top pq)))) 
  
  
 (define (spq-new p l) 
  
   ; Return a new priority queue containing the given elements in the 
   ; order determined by the given predicate. 
    
   (cons 'spq (pq-new p l))) 
  
  
 (define (spq-nq! spq e) 
  
   ; Add the given element to the given singleton priority queue. 
    
   (pq-nq! (cdr spq) e)) 
  
  
 (require rackunit "utl.rkt") 
  
  
 (let ((spq (spq-new < '(1 1 1 1 1)))) 
   (check-eq? (spq-empty? spq) #f) 
   (check-eq? (spq-head spq) 1) 
   (check-eq? (spq-dq! spq) 1) 
   (check-eq? (spq-empty? spq) #t)) 
  
  
 (let* 
  
   ((n 10) 
    (l (permuted-iota n)) 
    (spq (spq-new < (append l (permute-list l))))) 
  
   (do ((i 0 (+ i 1))) ((>= i n) (check-eq? (spq-empty? spq) #t)) 
     (check-eq? (spq-dq! spq) i))) 
  
 $ racket spq.rkt 
  
 $