問題3-21〜23

キューに関する問題です。先頭・最後尾の対や前後の対を指し示すポインタを操作する練習でもあります。
問題3-21では、例文に掲載されている手続きで作成したキューを、視覚的にわかりやすく印字するためのメソッドを定義します。front-queueをそのまま使っても良さそうですが、キューが空の時にエラーが発生してしまうロジックだったので、下記のようにしました。

(define (print-queue queue)
  (cond ((null? queue)
         (error "QUEUE is not defined" queue))
        (else
         (front-ptr queue))))

(define q1 (make-queue))

(insert-queue! q1 'a)  ;=>((a) a)
(print-queue q1)  ;=>(a)
(insert-queue! q1 'b)  ;=>((a b) b)
(print-queue q1)  ;=>(a b)
(delete-queue! q1)  ;=>((b) b)
(print-queue q1)  ;=>(b)
(delete-queue! q1)  ;=>(() b)
(print-queue q1)  ;=>()

問題3-22は、キューをディスパッチ方式で実装する問題です。注意深くポインタを操作することで実現することができます。

(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (insert! 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!)
      (cond ((null? front-ptr)
             (error "DELETE! called with an empty queue" front-ptr))
            (else
             (set! front-ptr (cdr front-ptr))
             front-ptr)))
    (define (dispatch m)
      (cond ((eq? m 'insert) insert!)
            ((eq? m 'delete) delete!)
            (else (error "Undefined operation" m))))
  dispatch))

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

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

(define q1 (make-queue))

(insert-queue! q1 'a)  ;=>(a)
(insert-queue! q1 'b)  ;=>(a b)
(delete-queue! q1)  ;=>(b)
(delete-queue! q1)  ;=>()

問題3-23はデキューの実装ということで、front-insert-queue!やrear-delete-queue!を使えるようにします。front-insert-queue!は、既存の手続きを変更することなく実装することができましたが、rear-delete-queue!を書いている時に、そのままではダメだということに気づきました。最後の要素を削除する時に、rear-ptrを一つ手前に持ってくる必要がありますが、その情報を拾える手段がありません。そこで、queueの各要素に、次の要素のポインタだけでなく、前の要素のポインタも持たせるようにしました。具体的には、(cons (cons item '前のポインタ) '次のポインタ)という形で実装しています。印字手続きにも修正を加え、以下のように書くことで、上手いこと実装することができました。

(define (make-queue) (cons '() '()))

(define (empty-queue? queue) (null? (front-ptr queue)))

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))

(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (set-prev-ptr! new-pair prev-pair)
  (set-cdr! (car new-pair) prev-pair))

(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))

(define (rear-insert-queue! queue item)
  (let ((new-pair (cons (cons item '()) '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-prev-ptr! new-pair (rear-ptr queue))
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))

(define (front-insert-queue! queue item)
  (let ((new-pair (cons (cons item '()) '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-prev-ptr! (front-ptr queue) new-pair)
           (set-cdr! new-pair (front-ptr queue))
           (set-front-ptr! queue new-pair)
           queue))))

(define (front-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue" queue))
        (else
         (set-prev-ptr! (front-ptr queue) '())
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue)))

(define (rear-delete-queue! queue)
  (let ((2nd-rear-ptr (cdr (car (rear-ptr queue)))))
    (cond ((empty-queue? queue)
           (error "DELETE! called with an empty queue" queue))
          ((null? 2nd-rear-ptr)
           (set-front-ptr! queue '())
           (set-rear-ptr! queue '())
           queue)
          (else
           (set-rear-ptr! queue 2nd-rear-ptr)
           (set-cdr! 2nd-rear-ptr '())
           queue))))
         
(define (print-queue queue)
  (define (iter pair)
    (if (null? pair)
        '()
        (cons (car (car pair)) (iter (cdr pair)))))
  (cond ((null? queue)
         (error "QUEUE is not defined" queue))
        (else
         (iter (front-ptr queue)))))
         
(define q1 (make-queue))

(rear-insert-queue! q1 'a)  ;=>(((a)) (a))
(print-queue q1)  ;=>(a)
(rear-insert-queue! q1 'b)  ;=>(#0=((a) . #1=((b . #0#))) . #1#)
(print-queue q1)  ;=>(a b)
(front-delete-queue! q1)  ;=>(#0=((b (a) . #0#)) . #0#)
(print-queue q1)  ;=>(b)
(front-delete-queue! q1)  ;=>(() (b))
(print-queue q1)  ;=>()
(front-insert-queue! q1 'c)  ;=>(((c)) (c))
(print-queue q1)  ;=>(c)
(front-insert-queue! q1 'd)  ;=>(#0=((d) . #1=((c . #0#))) . #1#)
(print-queue q1)  ;=>(d c)
(rear-delete-queue! q1)  ;=>(((d)) (d))
(print-queue q1)  ;=>(d)
(rear-delete-queue! q1)  ;=>(())
(print-queue q1)  ;=>()

insert/deleteの結果の印字はわけがわからないことになってしまいましたが、print-queueを通してやることで、正しく動いているだろうということを確認することができました。しかし、キューが循環してしまうことを防ぐための処置を施すという点にまで、考察を深めることはできませんでした。