関数型言語の勉強にSICPを読もう - (38) 3章 - 標準部品化力、オブジェクトおよび状態 (156ページ)

問題3.23

問題3.21の構造のままでfront-insert/rear-insert/front-deleteは O(1)を達成できるが、rear-deleteは無理。
なぜかというと rear-ptr を現在のrear-ptrの一つ手前の要素にしなければいけないから。
データの構造を変えなければいけないというのが僕の結論で、双方向リストにすれば良いかな。
(でも自信がないのでもし違っていたら教えてください)


データ構造を変えないとO(1)は無理だよなぁと気づきつつ何か良い方法があるに違いないと悶々としたしていたら2、3日経ってしまったという。


というわけで双方向リストで実装してみた。
一度方針を決めれば迷う部分は特にない。
(make-item)で 値/一つ前の要素/一つ後の要素を定義しています。

(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 (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))

(define (make-item value)
  (cons value (cons '() '())))

(define (set-next-item! item next)
  (set-cdr! (cdr item) next))

(define (next-item item)
  (cddr item))

(define (prev-item item)
  (cadr item))

(define (set-prev-item! item prev)
  (set-car! (cdr item) prev))

(define (value-of-item item)
  (car item))

(define (front-queue queue)
  (if (empty-queue? queue)
      (error "empty queue")
      ((value-of-item (front-ptr queue)))))

(define (rear-queue queue)
  (if (empty-queue? queue)
      (error "empty queue")
      ((value-of-item (rear-ptr queue)))))

(define (rear-insert-queue! queue value)
  (let ((new-item (make-item value)))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-item)
           (set-rear-ptr! queue new-item)
           queue)
          (else
           (set-prev-item! new-item (rear-ptr queue))
           (set-next-item! (rear-ptr queue) new-item)
           (set-rear-ptr! queue new-item)
           queue))))

(define (front-insert-queue! queue value)
  (let ((new-item (make-item value)))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-item)
           (set-rear-ptr! queue new-item)
           queue)
          (else
           (set-next-item! new-item (front-ptr queue))
           (set-front-ptr! queue new-item)
           queue))))

(define (front-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "empty queue"))
        (else
         (set-front-ptr! queue (next-item (front-ptr queue)))
         queue)))

(define (rear-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "empty queue"))
        (else
         (set-rear-ptr! queue (prev-item (rear-ptr queue)))
         queue)))

(define (display-queue queue)
  (define (display-queue-internal q)
    (cond ((eq? q (rear-ptr queue))
           (display " ")
           (display (value-of-item q)))
          (else
           (begin (display " ")
                  (display (value-of-item q))
                  (display-queue-internal (next-item q))))))
  (if (empty-queue? queue)
      (display "empty queue\n")
      (begin
        (display "(")
        (display-queue-internal (front-ptr queue))
        (display ")\n"))))

;; make-queue test
(define q1 (make-queue))
(display-queue q1)
;; empty queue


(rear-insert-queue! q1 'b)
(display-queue q1)
;;( b)

(front-insert-queue! q1 'a)
(display-queue q1)
;;( a b)

(rear-insert-queue! q1 'c)
(display-queue q1)
;;( a b c)

(front-insert-queue! q1 'Z)
(display-queue q1)
;;( Z a b c)


(front-delete-queue! q1)
(display-queue q1)
;;( a b c)

(rear-delete-queue! q1)
(display-queue q1)
;;( a b)

できた!
let1って使いどころがまだ分からないなぁ。
(let1 hoge 'a (begin (a) (b)))みたいに第3引数で2個以上式を評価したい場合には向かないという感覚でよいのかな。


※「SICPを読もう」の目次はこちら


計算機プログラムの構造と解釈
Gerald Jay Sussman Julie Sussman Harold Abelson 和田 英一
ピアソンエデュケーション (2000/02)
売り上げランキング: 56,404