sicp-ex-3.22

meteorgan

  
  
  
 (define (make-queue) 
   (let ((front-ptr '()) 
   (rear-ptr '())) 
   (define (empty-queue?) (null? front-ptr)) 
   (define (set-front-ptr! item) (set! front-ptr item)) 
   (define (set-rear-ptr! item) (set! rear-ptr item)) 
   (define (front-queue)  
     (if (empty-queue?) 
       (error "FRONT called with an empty queue") 
       (car front-ptr))) 
   (define (insert-queue! item) 
     (let ((new-pair (cons item '()))) 
       (cond ((empty-queue?) 
         (set-front-ptr! new-pair) 
         (set-rear-ptr! new-pair)) 
       (else  
         (set-cdr! rear-ptr new-pair) 
         (set-rear-ptr! new-pair))))) 
   (define (delete-queue!) 
     (cond ((empty-queue?) 
             (error "DELETE called with an empty queue")) 
     (else (set-front-ptr! (cdr front-ptr))))) 
      
         (define (print-queue) front-ptr) 
  
   (define (dispatch m) 
     (cond ((eq? m 'empty-queue) empty-queue?) 
     ((eq? m 'front-queue) front-queue) 
     ((eq? m 'insert-queue!) insert-queue!) 
     ((eq? m 'delete-queue!) delete-queue!) 
                 ((eq? m 'print-queue) print-queue) 
     (else (error "undefined operation -- QUEUE" m)))) 
   dispatch)) 
  
 }}}}

LisScheSic

My thoughts are almost same as Dewey's but at first I tried (define (set-front-ptr! queue item) (set! (front-ptr queue) item)) which will throw errors "variable required in this context" https://stackoverflow.com/a/59493589/21294350. I used (set-front-ptr! queue item) same as the book to give abstraction benefits but after rethoughts that is unnecessary since (set-front-ptr! queue item) has already done that.

This works with the tests of bro_chenzox's (Here I give print-queue to help viewing the dispatch procedure).

 (define (print-queue queue) 
   (cons (front-ptr queue) (rear-ptr queue))) 
  
 (define q (make-queue))  
 (empty-queue? q)      ; #t  
  
 (define (assert-predicate pred x y) 
   (assert (pred x y))) 
 (assert-predicate equal? '((a) a) (print-queue (insert-queue! q 'a)))   ; ((a) a)  
 (q 'front)           ; a  
 (empty-queue? q)      ; #f       
 (assert-predicate equal? '((a b) b) (print-queue (insert-queue! q 'b)))   ; ((a b) b)  
 (q 'front)           ; a  
  
 (assert-predicate equal? '((b) b) (print-queue (delete-queue! q)))     ; ((b) b)  
 (assert-predicate equal? '(() b) (print-queue (delete-queue! q)))     ; (())

---

IMHO Dewey's idea is better (reasons see Dewey's comment).

genovia

  
 ;;there is a little error in meteorgan's answer, in dispatch, should be (empty-queue?), not empty-queue, the same as delete-queue! 
  
 (define (make-queue) 
   (let ((front-ptr '()) (rear-ptr '())) 
     (define (set-front-ptr! item) (set! front-ptr item)) 
     (define (set-rear-ptr! item) (set! rear-ptr item)) 
  
     (define (empty-queue?) (null? front-ptr)) 
     ;;(define (make-queue) (cons '() '())) 
     (define (front-queue) 
       (if (empty-queue?) 
           (error "FRONT called with an empty queue" queue) 
           (car front-ptr))) 
  
     (define (insert-queue! item) 
       (let ((new-pair (cons item '()))) 
         (cond ((empty-queue?) 
                (set-front-ptr! new-pair) 
                (set-rear-ptr! new-pair)) 
               (else 
                (set-cdr! rear-ptr new-pair) 
                (set-rear-ptr! new-pair))) 
         front-ptr))  
  
     (define (delete-queue!) 
       (cond ((empty-queue?) 
              (error "DELETE! called with an empty queue" queue)) 
             (else 
              (set-front-ptr! (cdr front-ptr)))) 
       front-ptr)  
  
     (define (dispatch m) 
       (cond ((eq? m 'empty-queue?) (empty-queue?)) 
             ((eq? m 'front-queue) (front-queue)) 
             ((eq? m 'insert-queue!) insert-queue!) 
             ((eq? m 'delete-queue!) (delete-queue!)) 
             (else (error "Undefined oepration")))) 
  
     dispatch))

tf3

His answer his correct, he only has to ensure that he calls the empty-queue? method after dispatch returns it. He might have done it for the sake of consistency; your approach is also correct (and indeed more preferable).

Kaihao

There are some errors in genovia's answer.

First, in (error "FRONT called with an empty queue" queue) and (error "DELETE! called with an empty queue" queue), queue in not defined. We should change it to dispatch, which represents the queue.

Second, We should not return front-ptr in (insert-queue! item) and (delete-queue!). We should also change it to dispatch here.

The fixed code:

  
 (define (make-queue) 
   (let ((front-ptr '()) (rear-ptr '())) 
     (define (set-front-ptr! item) (set! front-ptr item)) 
     (define (set-rear-ptr! item) (set! rear-ptr item)) 
  
     (define (empty-queue?) (null? front-ptr)) 
  
     (define (front-queue) 
       (if (empty-queue?) 
           (error "FRONT called with an empty queue" dispatch) 
           (car front-ptr))) 
  
     (define (insert-queue! item) 
       (let ((new-pair (cons item '()))) 
         (cond ((empty-queue?) 
                (set-front-ptr! new-pair) 
                (set-rear-ptr! new-pair) 
                dispatch) 
               (else 
                (set-cdr! rear-ptr new-pair) 
                (set-rear-ptr! new-pair) 
                dispatch)))) 
  
     (define (delete-queue!) 
       (cond ((empty-queue?) 
              (error "DELETE! called with an empty queue" dispatch)) 
             (else 
              (set-front-ptr! (cdr front-ptr)))) 
       dispatch) 
  
     (define (dispatch m) 
       (cond ((eq? m 'empty-queue?) (empty-queue?)) 
             ((eq? m 'front-queue) (front-queue)) 
             ((eq? m 'insert-queue!) insert-queue!) 
             ((eq? m 'delete-queue!) (delete-queue!)) 
             (else (error "Undefined oepration: MAKE-QUEUE" m)))) 
  
     dispatch))

And the queue operations using this representation:

 (define (empty-queue? queue) (queue 'empty-queue?)) 
 (define (front-queue queue) (queue 'front-queue)) 
 (define (insert-queue! queue item) ((queue 'insert-queue!) item)) 
 (define (delete-queue! queue) (queue 'delete-queue!))

If we return nothing, instead of returning dispatch, in (insert-queue! item) and (delete-queue!):

     (define (insert-queue! item) 
       (let ((new-pair (cons item '()))) 
         (cond ((empty-queue?) 
                (set-front-ptr! new-pair) 
                (set-rear-ptr! new-pair)) 
                ;; dispatch deleted here 
               (else 
                (set-cdr! rear-ptr new-pair) 
                (set-rear-ptr! new-pair))))) 
                ;; dispatch deleted here 
  
     (define (delete-queue!) 
       (cond ((empty-queue?) 
              (error "DELETE! called with an empty queue" dispatch)) 
             (else 
              (set-front-ptr! (cdr front-ptr))))) 
              ;; dispatch deleted here

Then we need to return the queue in queue operations:

 (define (insert-queue! queue item) 
   ((queue 'insert-queue!) item) queue) 
 (define (delete-queue! queue) 
   (queue 'delete-queue!) queue)

bro_chenzox

Here is the answer with tests

  
 (define (make-queue) 
   (let ((front-ptr '()) 
           (rear-ptr '())) 
     (define (set-front-ptr! item) (set! front-ptr item)) 
     (define (set-rear-ptr! item) (set! rear-ptr item)) 
     (define (empty-queue?) (null? front-ptr)) 
     (define new-queue (cons front-ptr rear-ptr)) 
     (define (front-queue) 
       (cond ((empty-queue?) 
                   (error "FRONT-QUEUE called with an empty queue")) 
                  (else (car front-ptr)))) 
     (define (insert-queue!) 
       (lambda (item) 
         (let ((new-pair (cons item '()))) 
           (cond ((empty-queue?) 
                       (set-front-ptr! new-pair) 
                       (set-rear-ptr! new-pair) 
                       (cons front-ptr rear-ptr)) 
                      (else 
                        (set-cdr! rear-ptr new-pair) 
                        (set-rear-ptr! new-pair) 
                        (cons front-ptr rear-ptr)))))) 
     (define (delete-queue!) 
       (cond ((empty-queue?) 
                   (error "DELETE-QUEUE! called with an empty queue")) 
                  (else 
                   (set-front-ptr! (cdr front-ptr)) 
                   (if (pair? front-ptr) 
                       (cons front-ptr rear-ptr) 
                       new-queue)))) 
     (define (dispatch m) 
       (cond ((eq? m 'empty?) (empty-queue?)) 
                  ((eq? m 'front) (front-queue)) 
                  ((eq? m 'insert) (insert-queue!)) 
                  ((eq? m 'delete) (delete-queue!)) 
                  (else (error "DISPATCH called with unknown operation")))) 
     dispatch)) 
  
 (define q (make-queue)) 
 (q 'empty?)      ; #t 
 ((q 'insert) 'a)   ; ((a) a) 
 (q 'front)           ; a 
 (q 'empty?)      ; #f      
 ((q 'insert) 'b)   ; ((a b) b) 
 (q 'front)           ; a 
  
 (q 'delete)      ; ((b) b) 
 (q 'delete)      ; (())

denis manikhin

I suggest making the code shorter. Fewer letters means fewer errors.

#lang sicp
(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (insert-q! item)
      (let ((new-pair (cons item '())))
        (cond ((null? front-ptr) (set! front-ptr new-pair)
                                 (set! rear-ptr new-pair) front-ptr)
              (else (set-cdr! rear-ptr new-pair)
                    (set! rear-ptr new-pair) front-ptr))))
    (define (delete-q!)
      (cond ((null? front-ptr)
             (error "DELETE! called with an empty queue" front-ptr))
            (else (set! front-ptr (cdr front-ptr )) front-ptr)))
    (define (front-q)
      (if (null? front-ptr)
          (error "FRONT called with an empty queue" front-ptr)
          (car front-ptr)))
    (define (dispatch m)
      (cond ((eq? m 'insert) insert-q!)
            ((eq? m 'delete) (delete-q!))
            ((eq? m 'front) (front-q))
            (else (error "Unknown command:" m))))
    dispatch))

Dewey

I suggest implement queue just like the way implement 'cons' in the section : Mutation is just assignment.

The benefit of doing in this way:

1.The expression that call of queue operation won't change. We can call them just like before: (insert-queue! q 'a)

2.Keep good abstraction barrier. Notice that the code of empty-queue?, front-queue, insert-queue!, delete-queue! don't need change at all

 #lang sicp 
  
 ;; One level of abstraction: select and to modify the front and rear pointers of a queue: 
 (define (make-queue) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
     (define (set-front-ptr! item) 
       (set! front-ptr item)) 
     (define (set-rear-ptr! item) 
       (set! rear-ptr item)) 
     (define (dispatch m) 
       (cond ((eq? m 'front-ptr) front-ptr) 
             ((eq? m 'rear-ptr) rear-ptr) 
             ((eq? m 'set-front-ptr!) set-front-ptr!) 
             ((eq? m 'set-rear-ptr!) set-rear-ptr!) 
             (else 
              (error "Undefined operation: QUEUE" m)))) 
     dispatch)) 
  
 (define (front-ptr q) (q 'front-ptr)) 
 (define (rear-ptr q) (q 'rear-ptr)) 
 (define (set-front-ptr! q item) 
   ((q 'set-front-ptr!) item)) 
 (define (set-rear-ptr! q item) 
   ((q 'set-rear-ptr!) item)) 
  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 ;; Next level abstraction: Queue operations. No change. 
 (define (empty-queue? queue) 
   (null? (front-ptr queue))) 
 (define (front-queue queue) 
   (if (empty-queue? queue) 
       (error "FRONT called with an empty queue" queue) 
       (car (front-ptr queue)))) 
 (define (insert-queue! queue item) 
   (let ((new-pair (cons item '()))) 
     (cond ((empty-queue? queue) 
            (set-front-ptr! queue new-pair) 
            (set-rear-ptr! queue new-pair) 
            queue) 
           (else 
            (set-cdr! (rear-ptr queue) new-pair) 
            (set-rear-ptr! queue new-pair) 
            queue)))) 
 (define (delete-queue! queue) 
   (cond ((empty-queue? queue) 
          (error "DELETE! called with an empty queue" queue)) 
         (else (set-front-ptr! queue (cdr (front-ptr queue))) 
               queue))) 
  
 ;; TEST 
 (define q (make-queue)) 
 (insert-queue! q 'a) (front-ptr q);a 
 (front-queue q) ;a 
 (insert-queue! q 'b)(front-ptr q) ;a b 
 (delete-queue! q) (front-ptr q);b 
 (insert-queue! q 'c) (front-ptr q);b c 
 (insert-queue! q 'd) (front-ptr q);b c d 
 (delete-queue! q) (front-ptr q);c d