問題3.21-3.23 - nrvctの日記

3.21-3.23はqueueの実装です。set-car!とset-cdr!を使って実装できます。
例のごとく構成子と選択子を作って実装します。
構成子とか選択子とかの考え方はコードを分かり易くするし、便利な考え方だと思います。

3.21

> (define q1 (make-queue))
> (insert-queue! q1 'a)
((a) a)
> (insert-queue! q1 'b)
((a b) b)
> (delete-queue! q1)
((b) b)
> (delete-queue! q1)
(() b)

insert-queue!やdelete-queue!はqueueその物、つまり実際の並びの先頭と最後へのポインタの対を返すので、schemeの処理系の印字方法で印字されると上のようになってしまう。
上の例を図で考えると、SICPp.155の図のqを評価し印字していることになる。
queueを表示するprint-queueを以下のように定義すればよい。

(define (print-queue queue) (front-ptr queue))

> (define q1 (make-queue))
> (print-queue (insert-queue! q1 'a))
(a)
> (print-queue (insert-queue! q1 'b))
(a b)
> (print-queue (delete-queue! q1))
(b)
> (print-queue (delete-queue! q1))
()

3.22

(define (make-queue2)
  (let ((front-ptr '()) (rear-ptr '()))
    (define (empty?) (null? front-ptr))
    (define (insert! x)
      (cond ((empty?)
             (set! front-ptr (cons x '()))
             (set! rear-ptr front-ptr)
             front-ptr)
            (else
             (set-cdr! rear-ptr (cons x '()))
             (set! rear-ptr (cdr rear-ptr))
             front-ptr)))
    (define (delete!)
      (cond ((empty?)
             (error "DELETE! called with an empty queue"))
            (else
             (set! front-ptr (cdr front-ptr))
             front-ptr)))
    (define (print) front-ptr)
    (define (front) front-ptr)
    (define (rear) rear-ptr)
    (define (dispatch m)
      (cond ((eq? m 'print) print)
            ((eq? m 'front) front)
            ((eq? m 'rear) rear)
            ((eq? m 'insert) insert!)
            ((eq? m 'delete) delete!)
            (else
             (error "Undefined message" m))))
    dispatch))

> (define q (make-queue2))
> ((q 'insert) 1)
(1)
> ((q 'insert) 2)
(1 2)
> ((q 'insert) 3)
(1 2 3)
> ((q 'print))
(1 2 3)
> ((q 'front))
(1 2 3)
> ((q 'rear))
(3)
> ((q 'delete))
(2 3)
> ((q 'delete))
(3)
> ((q 'delete))
()
> ((q 'delete))
DELETE! called with an empty queue

make-queueをメッセージパッシング的に実装。
名前が衝突するのでmake-queue2にしました。
insertとかdeleteとかは!つけた方がいいのかな。でもdepositとかはつけてなかったし別にいいような気もする。局所変数の変更するだけだし。

3.23

全ての演算が $\Theta(1)$ ステップでなければならないらしいので、構造を双方向連結リストみたいにしないとだめなんじゃないだろうか。
あと循環する構造っていうのは、insert系の手続きにキュー自身を入れるってことかな。よく分からない。
でも、insert時に常に新しいオブジェクトを作るようにすれば大丈夫な気がするので、そういう風に書いてみる。

まず、queue自身は今までどおり。
各queueのitemは、構成子make-queue-itemで(prev item . next)のように作る。
queue-prev,item,nextはmake-queue-itemに対応する選択子。
queue-prev-set!,queue-next-set!はprevとnextを変更する変更子。
print-queueは内部では双方向連結リストになっているデータを、queueみたいにリストで表示する手続きとする。

(define (make-queue) (cons '() '()))
(define (empty-queue? queue) (null? (front-queue queue)))
(define (front-queue queue) (car queue))
(define (rear-queue queue) (cdr queue))
(define (make-queue-item prev item next) (cons prev (cons item next)))
(define (queue-prev item) (car item))
(define (queue-item item) (cadr item))
(define (queue-next item) (cddr item))
(define (queue-prev-set! item x) (set-car! item x))
(define (queue-next-set! item x) (set-cdr! (cdr item) x))
(define (print-queue queue)
  (define (iter queue-item-list)
    (if (null? queue-item-list)
        '()
        (cons (queue-item queue-item-list)
              (iter (queue-next queue-item-list)))))
  (iter (front-queue queue)))
(define (front-insert-queue! queue x)
  (cond ((empty-queue? queue)
         (let ((new (make-queue-item '() x '())))
           (set-car! queue new)
           (set-cdr! queue new)
           (print-queue queue)))
        (else
         (let ((new (make-queue-item '() x (front-queue queue))))
           (queue-prev-set! (front-queue queue) new)
           (set-car! queue new)
           (print-queue queue)))))
(define (rear-insert-queue! queue x)
  (let ((new (make-queue-item (rear-queue queue) x '())))
    (cond ((empty-queue? queue)
           (set-car! queue new)
           (set-cdr! queue new)
           (print-queue queue))
          (else
           (queue-next-set! (rear-queue queue) new)
           (set-cdr! queue new)
           (print-queue queue)))))
(define (front-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "FRONT-DELETE-QUEUE! called with an empty queue" queue))
        ((eq? (front-queue queue) (rear-queue queue))
         (set-car! queue '())
         (set-cdr! queue '())
         (print-queue queue))
        (else
         (set-car! queue (queue-next (front-queue queue)))
         (queue-prev-set! (front-queue queue) '())
         (print-queue queue))))
(define (rear-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "REAR-DELETE-QUEUE! called with an empty queue" queue))
        ((eq? (front-queue queue) (rear-queue queue))
         (set-car! queue '())
         (set-cdr! queue '())
         (print-queue queue))
        (else
         (set-cdr! queue (queue-prev (rear-queue queue)))
         (queue-next-set! (rear-queue queue) '())
         (print-queue queue))))

> (define q (make-queue))
> (front-insert-queue! q 1)
(1)
> (front-insert-queue! q 2)
(2 1)
> (rear-insert-queue! q 3)
(2 1 3)
> (rear-insert-queue! q 4)
(2 1 3 4)
> (front-insert-queue! q 5)
(5 2 1 3 4)
> (rear-delete-queue! q)
(5 2 1 3)
> (rear-delete-queue! q)
(5 2 1)
> (front-delete-queue! q)
(2 1)
> (front-delete-queue! q)
(1)
> q
((() 1) () 1)
> (front-insert-queue! q 8)
(8 1)
> q
(#0=(() 8 . #1=(#0# 1)) . #1#)
> (rear-delete-queue! q)
(8)
> q
((() 8) () 8)
> (front-delete-queue! q)
()
> (rear-delete-queue! q)
REAR-DELETE-QUEUE! called with an empty queue (())

たぶんできました。疲れた。