Scheme - 可変データでのモデル化(デキュー(deque(double-ended queue)) )

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

• OS X Lion - Apple(OS)
• Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
• プログラミング言語: MIT/GNU Scheme

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の3(標準部品化力, オブジェクトおよび状態)、3.3(可変データでのモデル化)、3.3.2(キューの表現)の問題 3.23を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題3.23

コード(BBEdit)

sample.scm

(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 (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))

(define (rear-queue queue)
  (if (empty-queue? queue)
      (error "REAR called with an empty queue" queue)
      (car (rear-ptr queue))))

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

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

(define (front-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "FRONT-DELETE! called with an empty queue" queue))
        ((eq? (front-ptr queue) (rear-ptr queue))
         (set-front-ptr! queue '())
         (set-rear-ptr! queue '())
         (print-queue queue))
        (else
         (set-front-ptr! queue (cddr (front-ptr queue)))
         (set-car! (cdr (front-ptr queue)) '())
         (print-queue queue))))

(define (rear-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "REAR-DELETE! called with an empty queue" queue))
        ((eq? (front-ptr queue) (rear-ptr queue))
         (set-front-ptr! queue '())
         (set-rear-ptr! queue '())
         (print-queue queue))
        (else
         (set-rear-ptr! queue (cadr (rear-ptr queue)))
         (set-cdr! (cdr (rear-ptr queue)) '())
         (print-queue queue))))

(define (print-queue queue)
  (define (iter p)
    (if (null? p)
        '()
        (cons (car p)
              (iter (cddr p)))))
  (iter (front-ptr queue)))

(define q (make-queue))

入出力結果(Terminal, REPL(Read, Eval, Print, Loop))

1 ]=> (print-queue q)

;Value: ()

1 ]=> (front-insert-queue! q 'a)

;Value 2: (a)

1 ]=> (front-insert-queue! q 'b)

;Value 3: (b a)

1 ]=> (rear-insert-queue! q 'c)

;Value 4: (b a c)

1 ]=> (rear-insert-queue! q 'd)

;Value 5: (b a c d)

1 ]=> (front-delete-queue! q)

;Value 6: (a c d)

1 ]=> (rear-delete-queue! q)

;Value 7: (a c)

1 ]=> (front-delete-queue! q)

;Value 8: (c)

1 ]=> (rear-delete-queue! q)

;Value: ()