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

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

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第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プロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 3.23.

queueはリストの最初と最後の対を指示する一対のポインタで表現、実装されているため、そのままLispの解釈系に印字させてもリストとして印字されない。

コード(BBEdit, Emacs)

deque.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

;; 双方向リストの簡単な実装
;; 構成子
(define (make-doubly-linked-list) '())

;; 構成子(双方向リストの要素)
(define (make-item data) (list '() '() data))

;; 選択子
(define (prev-item item) (car item))
(define (next-item item) (cadr item))
(define (data-item item) (caddr item))

;; 変更子
(define (set-prev! item prev) (set-car! item prev))
(define (set-next! item next) (set-car! (cdr item) next))

;; dequeue(double-ended queue)
;; 構成子(ポインタの対を使って表現。dequeは双方向リスト)
(define (make-deque) (cons (make-doubly-linked-list)
                           (make-doubly-linked-list)))

;; 述語
(define (empty-deque? deque) (null? (front-ptr deque)))

;; 選択子(ポインタ)
(define (front-ptr deque) (car deque))
(define (rear-ptr deque) (cdr deque))

;; 変更子(ポインタ)
(define (set-front-ptr! deque item) (set-car! deque item))
(define (set-rear-ptr! deque item) (set-cdr! deque item))


;; 選択子
(define (front-deque deque)
  (if (empty-deque? deque)
      (error "FRONT called with an empty deque" deque)
      (data-item (front-ptr deque))))
(define (rear-deque deque)
  (if (empty-deque? deque)
      (error "REAR called with an empty deque" deque)
      (data-item (rear-ptr deque))))

;; 変更子
(define (front-insert-deque! deque data)
  (let ((new-item (make-item data)))
    (if (empty-deque? deque)
        (begin (set-front-ptr! deque new-item)
               (set-rear-ptr! deque new-item)
               deque)
        (begin (set-next! new-item (front-ptr deque))
               (set-front-ptr! deque new-item)
               deque))))
(define (rear-insert-deque! deque data)
  (let ((new-item (make-item data)))
    (if (empty-deque? deque)
        (begin (set-front-ptr! deque new-item)
               (set-rear-ptr! deque new-item)
               deque)
        (begin (set-prev! new-item (rear-ptr deque))
               (set-next! (rear-ptr deque) new-item)
               (set-rear-ptr! deque new-item)
               deque))))

(define (front-delete-deque! deque)
  (if (empty-deque? deque)
      (error "DELETE! called with an empty deque" deque)
      (let ((new-front (next-item (front-ptr deque))))
        (if (null? new-front)
            (begin (set-front-ptr! deque new-front)
                   (set-rear-ptr! deque new-front)
                   deque)
            (begin (set-front-ptr! deque new-front)
                   (set-prev! new-front '())
                   deque)))))

(define (rear-delete-deque! deque)
  (if (empty-deque? deque)
      (error "DELETE! called with an empty deque" deque)
      (let ((new-rear (prev-item (rear-ptr deque))))
        (if (null? new-rear)
            (begin (set-front-ptr! deque new-rear)
                   (set-rear-ptr! deque new-rear)
                   deque)
            (begin
              (set-rear-ptr! deque new-rear)
              (set-next! new-rear '())
              deque)))))

;; dequeを印字
(define (print-deque deque)
  (if (empty-deque? deque)
      (print "")
      (let ((t '()))
        (define (iter item)
          (if (null? item)
              (print "")
              (if (memq item t)
                  (print "循環")
                  (begin (set! t (cons item t))
                         (display (data-item item))
                         (display " ")
                         (iter (next-item item))))))
        (iter (front-ptr deque)))))

sample3_23.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

(load "./deque.scm")

(define q (make-deque))
(print-deque q)

(front-insert-deque! q 'a)
(print-deque q)

(front-insert-deque! q 'b)
(print-deque q)

(rear-insert-deque! q 'c)
(print-deque q)

(rear-insert-deque! q 'd)
(print-deque q)

(front-delete-deque! q)
(print-deque q)

(rear-delete-deque! q)
(print-deque q)

(rear-delete-deque! q)
(print-deque q)

(rear-delete-deque! q)
(print-deque q)

(rear-delete-deque! q)
(print-deque q)

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

$ ./sample3_23.scm

a 
b a 
b a c 
b a c d 
a c d 
a c 
a 

gosh: "error": DELETE! called with an empty deque (())
$