ImperativeQueues - Cookbook - s c h e m a t i c s : c o o k b o o k

Imperative Queues

Problem

A queue is a first-in first-out memory. Objects can be stored one by one and can be extracted (or removed) one by one. Objects are extracted (or removed) in the same time order as they are stored. How to implement a queue with constant access time, i.e. independent of the length of the queue? (Compare this problem with that of recipe FunctionalQueue).

Solution

The solution shown in this recipe is in essence the same as described in section 3.3.2 of SICP. However, in this recipe the word 'pointer' is avoided. Each queue will have its own set of six procedures, say queue-empty?, queue-enter!, queue-extract!, queue-peek, queue-remove! and queue->list.

1: (queue-empty? ) → #t if the queue is empty, else #f.
2: (queue-enter! object) → void, enters the object in the queue.
3: (queue-extract! [thunk]) → removes an object from the queue and returns that object.
4: (queue-peek [thunk]) → returns the next object of the queue without removing it.
5: (queue-remove! [thunk]) → void, removes an object from the queue.
6: (queue->list ) → copy of the queue (a newly allocated immutable list with the same (eq?) contents as the queue)

These six procedures share access to a freshly allocated queue. The queue can be accessed by means of these six procedures only. Every distinct queue has its own distinct set of six procedures. Initially the queue is empty. When the queue is empty, the procedures queue-extract!, queue-peek or queue-remove! return whatever is returned by the thunk or signal an error if no thunk is supplied. The procedures are prepared by means of procedure make-queue:

(make-queue [string]) → multiple value of six procedures

The optional string is used in error messages in order to identify the queue. It has no other use. The default string is "no name".

The internal representation for the queue is a mutable list containing the entered objects in the reversed order, i.e. the most recent one at the end and the oldest one at the start. Procedure queue-enter! appends an object at the end of the queue. This is done in situ (i.e. destructively) Procedures queue-extract!, queue-peek and queue-remove! apply to the first element of the queue. Procedures queue-extract! and queue-remove! replace the queue by its cdr, thus removing the oldest element. A simple, but inefficient implementation (without names, thunks or error-detection) is

; WARNING: this is an inefficient implementation

(define (make-queue)
 (let ((queue ()))
  (values
   (lambda () (null? queue))             ; queue-empty?   in constant time.
   (lambda (object)                      ; queue-enter!   NOT in constant time
    (let ((new-pair (list object)))      ; because of the use of procedure last-pair.
     (if (null? queue)
      (set! queue new-pair)
      (set-mcdr! (last-pair queue) new-pair)))) ; (last-pair is not required by R5RS)
   (lambda ()                            ; queue-extract! in constant time.
    (let ((object (mcar queue)))
     (set! queue (mcdr queue)) object))
   (lambda () (mcar queue))              ; queue-peek,    in constant time.
   (lambda () (set! queue (mcdr queue))) ; queue-remove!  in constant time.
   (lambda () (mlist->list queue)))))    ; queue->list O(length of queue).

In this implementation, procedure queue-enter! is inefficient, because it calls procedure last-pair, which does a full traversal of the queue. In order to avoid this traversal, the last pair must be memorized:

(define (make-queue)
 (let ((queue ()) (last-pair ()))        ; last-pair always is the last pair of the queue, except when the queue is empty.
  (values                                ; for an empty queue last-pair has no meaning. The initial value is arbitrarily choosen to be ()
   (lambda () (null? queue))             ; queue-empty?   same as before.
   (lambda (object)                      ; queue-enter!   now in constant time indeed.
    (let ((new-pair (mlist object)))
     (if (null? queue)
      (set! queue new-pair)
      (set-mcdr! last-pair new-pair))
     (set! last-pair new-pair)))
   (lambda ()                            ; queue-extract! same as before.
    (let ((object (mcar queue)))
     (set! queue (mcdr queue)) object))
   (lambda () (mcar queue))              ; queue-peek,    same as before.
   (lambda () (set! queue (mcdr queue))) ; queue-remove!  same as before.
   (lambda () (mlist->list queue)))))    ; queue->list    same as before.

Example of use:

(define-values
 (queue-empty? queue-enter! queue-extract! queue-peek queue-remove! queue->list)
 (make-queue))

; operation            new-queue       new-last-pair
;                      ()              ()
(enter! 1) ; --> void, {1)             {1}
(enter! 2) ; --> void, {1 2}           {2}
(enter! 3) ; --> void, {1 2 3}         {3}
(extract!) ; --> 1   , {2 3}           {3}
(enter! 4) ; --> void, {2 3 4}         {4}
(extract!) ; --> 2   , {3 4}           {4}
(extract!) ; --> 3   , {4}             {4}
(extract!) ; --> 4   , ()              ()

Now it is a matter of routine in order to prepare the full implemention, name, thunk arguments and error detection included:

(module queues mzscheme (provide make-queue)
 
 (define make-queue
  (case-lambda
   (() (make-queue "no name"))
   ((queue-name)
    (if (not (string? queue-name))
     (raise-type-error 'make-queue "string" queue-name)
     (let              ; local state variables
      ((queue ())      ; the queue proper
       (last-pair ())) ; always the last pair of the queue
      
      (define (queue-empty?) (null?       queue))
      (define (queue-peek  ) (mcar        queue))
      (define (queue->list ) (mlist->list queue))
      
      (define (queue-enter! object)
       (let ((new-pair (mcons object ())))
        (if (queue-empty?)
         (set! queue new-pair)
         (set-mcdr! last-pair new-pair))
        (set! last-pair new-pair)))
      
      (define (queue-extract!)
       (let ((entry (queue-peek))) (queue-remove!) entry))
      
      (define (queue-remove!)
       (set! queue (mcdr queue))
       (if (queue-empty?) (set! last-pair ())))
      
      (define (make-proc-with-default proc proc-name)
       ; accepts a procedure of no arguments and returns a procedure
       ; accepting an optional thunk, calling this thunk (or raising
       ; an error if no thunk is given) if the queue is empty. If the
       ; queue is not empty, the proc is called.
       (letrec
        ((default (lambda () (empty-queue-error proc-name queue-name)))
         (new-proc
          (case-lambda
           (() (new-proc default))
           ((thunk)
            (cond
             ((not (procedure? thunk))
              (raise-type-error 'proc-name "thunk" thunk))
             ((not (procedure-arity-includes? thunk 0))
              (raise-type-error proc-name
               "procedure accepting no arguments" thunk))
             ((queue-empty?) (thunk))
             (else (proc)))))))
        new-proc))
       
      (let-syntax
       ((with-default ; avoid double typing the proc-name
         (syntax-rules ()
          ((with-default proc-name)
           (make-proc-with-default proc-name 'proc-name)))))
       (values
        queue-empty?
        queue-enter!
        (with-default queue-extract!)
        (with-default queue-peek)
        (with-default queue-remove!)
        queue->list)))))))
 
 (define (empty-queue-error proc-name queue-name)
  (error
   (string-append "queue-procedure "
    (symbol->string proc-name)
    " applied to queue "queue-name" while being empty."))))

A good alternative is to implement the queues as a class of objects with two private variables queue and last-pair and methods empty?, enter!, extract!, peek, remove!, queue->list and name:

(module queues mzscheme 
 (provide queue%)
 (require (lib "class.ss"))

 (define queue% 
  (class* object%
   ((interface () empty? enter! extract! remove! peek queue->list name))
   (public empty? enter! extract! remove! peek queue->list name)
   
   ; name
   
   (init (init-queue-name "no name"))
   (define queue-name #f)
   (if (not (string? init-queue-name))
    (raise-type-error '|queue% constr| "string"init-queue-name )
    (set! queue-name init-queue-name))
   
   ; local state
   
   (define queue ())
   (define last-pair ())
   
   ; internal methods

   (define (    peek-intern) (mcar queue))
   (define (extract!-intern) (let ((entry (peek-intern))) (remove!-intern) entry))
   (define ( remove!-intern) (set! queue (mcdr queue)))
   
   ; methods
   
   (define-syntax give-default
    (syntax-rules ()
     ((give-default proc proc-name)
      (define proc-name
       (case-lambda
        (() (proc-name (lambda () (empty-error (symbol->string 'proc-name)))))
        ((thunk) (call-internal-method proc thunk 'proc-name)))))))

   (define (name) queue-name)
   (define (empty?) (null? queue))
   (define (queue->list) (mlist->list queue))
   (give-default extract!-intern extract!)
   (give-default  remove!-intern remove! )
   (give-default     peek-intern peek    )
   
   (define (enter! item)
    (let ((new-pair (mcons item ())))
     (if (empty?)
      (set! queue new-pair) 
      (set-mcdr! last-pair new-pair))
     (set! last-pair new-pair)))
   
   ; auxiliary procedures
   
   (define (call-internal-method proc thunk proc-name)
    (cond
     ((not (and (procedure? thunk) (procedure-arity-includes? thunk 0)))
      (raise-type-error proc-name "thunk" thunk))
     ((null? queue) (thunk))
     (else (proc))))
   
   (define (empty-error method-name)
    (error
     (string-append "class queue: method " method-name
      " applied to queue " queue-name " while the queue is empty.")))
   
   (super-new))))

Comments about this recipe

Very welcome. Code adapted to MzScheme version 3.99.0.9. All code requires: (require scheme/mpair) JosKoot 09-01-2008

Contributors

-- JosKoot - 11 October 2006

CookbookForm
TopicType:	Recipe
ParentTopic:	DataStructureRecipes
TopicOrder:	999

PLT Scheme	SISC
Scheme48	SCM
MIT Scheme	scsh
JScheme	Kawa
Chicken	Guile
Bigloo	Tiny
Gambit	LispMe
Gauche	Chez