Scheme - 標準部品化力、オブジェクトおよび状態(可変データのモデル化(キューの表現(deque(double-ended queue))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X El Capitan - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• kscheme (github) (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: 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
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題3.23.

コード(Emacs)

(begin
  (define (print obj)
    (display obj)
    (newline))

  (define (make-item value)
    (cons value (cons '() '())))
  (define (value item) (car item))
  (define (prev item) (cadr item))
  (define (next item) (cddr item))
  (define (set-value! item value) (set-car! item value))
  (define (set-prev-ptr! item ptr) (set-car! (cdr item) ptr))
  (define (set-next-ptr! item ptr) (set-cdr! (cdr item) ptr))
  
  (define (make-queue) (cons '() '()))
  (define (front-ptr queue) (car queue))
  (define (rear-ptr queue) (cdr queue))
  (define (empty-queue? queue) (null? (front-ptr queue)))
  (define (set-front-ptr! queue item) (set-car! queue item))
  (define (set-rear-ptr! queue item) (set-cdr! queue item))
  (define (front-queue queue)
    (if (empty-queue? queue)
        (begin (display "Error: front called with an empty queue -- ")
               (print queue))
        (value (front-ptr queue))))
  (define (rear-queue queue)
    (if (empty-queue? queue)
        (begin (display "Error: rear called with an empty queue -- ")
               (print queue))
        (value (rear-ptr queue))))
  (define (front-insert-queue! queue value)
    (let ((item (make-item value)))
      (if (empty-queue? queue)
          (begin (set-front-ptr! queue item)
                 (set-rear-ptr! queue item))
          (begin (set-prev-ptr! (front-ptr queue) item)
                 (set-next-ptr! item (front-ptr queue))
                 (set-car! queue item)))
      queue))
  (define (rear-insert-queue! queue value)
    (let ((item (make-item value)))
      (if (empty-queue? queue)
          (begin (set-front-ptr! queue item)
                 (set-rear-ptr! queue item))
          (begin (set-prev-ptr! item (rear-ptr queue))
                 (set-next-ptr! (rear-ptr queue) item)
                 (set-rear-ptr! queue item)))
      queue))
  (define (front-delete-queue! queue)
    (if (empty-queue? queue)
        (begin (display "Error: delete! called with an empty queue ")
               (print queue))
        (begin (set-front-ptr! queue (next (front-ptr queue)))
               (set-prev-ptr! (front-ptr queue) '())
               queue)))
  (define (rear-delete-queue! queue)
    (if (empty-queue? queue)
        (begin (display "Error: delete! called with an empty queue ")
               (print queue))
        (begin (set-rear-ptr! queue (prev (rear-ptr queue)))
               (set-next-ptr! (rear-ptr queue) '())
               queue)))
  (define (print-queue queue)
    (define (iter item)
      (if (not (null? item))
          (begin (display (value item))
                 (if (not (null? (next item)))
                     (display " "))
                 (iter (next item)))))
    (display "(")
    (iter (front-ptr queue))
    (print ")"))

  (define q (make-queue))
  (print-queue q)
  (print-queue (rear-insert-queue! q (quote a)))
  (print-queue (rear-insert-queue! q (quote b)))
  (print-queue (front-insert-queue! q (quote c)))
  (print-queue (front-insert-queue! q (quote d)))
  (print-queue (rear-delete-queue! q))
  (print-queue (front-delete-queue! q))
  )

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

$ ./kscheme sample23.scm
()
(a)
(a b)
(c a b)
(d c a b)
(d c a)
(c a)
$