計算機プログラムの構造と解釈 第二版 P156 問題3.23

思いつくのは簡単、実装にやたら時間がかかった。

dequeの仕組みをθ(1)で作るには、双方向リストがあればいいのかな？
ってのはなんか解る。
なんでかっていうと、一番後ろにあるデータを取り除く時を考える。
一番後ろの一個前とかを、バカ正直に前から順番ににとりにいこうとすると、
そもそもθ(1)ではいかない。
でもschemeに乗っかってるリストってのは基本そういう構造で、前から後ろは進めるけど、後ろから前には進めない。

双方向リストのC言語での実装はいろんな本に載ってる。
C言語ポインタ完全制覇 (標準プログラマーズライブラリ)(簡単に書かれていていいと思う)
とか、
定本 Cプログラマのためのアルゴリズムとデータ構造 (SOFTBANK BOOKS)とかプログラミング言語C 第2版 ANSI規格準拠
ここら辺の本に基本的なデータ構造については詳しく書いてあるから、
双方向リストに関する説明はしない。

このリストの頭の部分へのポインタと、お尻の部分へのポインタをもってればいろいろできる。
このqueueのデータ一個一個の事をnodeって呼ぶ。

さてschemeで双方向リストってどうやって実装するんだってところで模索。
具体的にはnodeのデータ構造をschemeではどうしたら良いかとか、そういう事で悩んだ。
結局リスト(対)で表現するしかないんだけど。

( [値] [前のnodeへのポインタ] [次のnodeへのポインタ]

みたくした。

一番先頭のnodeを切り落としたければ、2番目のnodeの、前のnodeへのポインタをnilにすればいいって事ですな。
一番後ろのnodeを切り落としたければ、後ろから2番目のnodeの、次のnodeへのポインタをnilにすればいいって事ですな。

そういう事で実装。

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

(define nil '())
(define disp display)
(define nl newline)


(define (make-queue)
  (cons nil nil))

(define (front-ptr queue)
  (car queue))

(define (rear-ptr queue)
  (cdr queue))

(define (empty-queue? queue)
  (null? (front-ptr queue)))


;;双方向リストのノードを作成用手続き
(define (make-node value prev-node next-node)
  (list value prev-node next-node))

;;前のノード取得への手続き
(define (prev-node node)
  (cadr node))


;;次のノード取得の手続き
(define (next-node node)
  (cddr node))


;;ノードの値を取得
(define (value-node node)
  (if (null? node) '() 
    (car node)))

;;前のノードにノードをつなげる手続き
(define (set-prev-node! node prev)
  (begin (set-car! (cdr node) prev)
         (set-cdr! (cdr prev) node)))

;;次のノードにノードをつなげる手続き
(define (set-next-node! node next)
  (begin (set-cdr! (cdr node) next)
         (set-car! (cdr next) node)))


(define (value-list final-node)
  (define (print-list-i node result)
    (if (null? (prev-node node))
      (cons (value-node node) result)
      (print-list-i (prev-node node) (cons (value-node node) result))))
  (if (null? final-node) '()
    (print-list-i final-node '())))


(define (print-queue queue)
  (print (value-list (rear-ptr queue))))

(define (rear-insert-queue! queue item)
  (if (empty-queue? queue)
    (begin (set-car! queue (make-node item nil nil))
           (set-cdr! queue (car queue)))
    (begin (set-next-node! (rear-ptr queue) (make-node item nil nil))
           (set-cdr! queue (next-node (rear-ptr queue))))))

(define (insert-queue! queue item)
  (if (empty-queue? queue)
    (begin (set-car! queue (make-node item nil nil))
           (set-cdr! queue (car queue)))
    (begin (set-prev-node! (front-ptr queue) (make-node item nil nil))
           (set-car! queue (prev-node (front-ptr queue))))))


(define (front-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "FRONT-DELETE-QUEUE! called with an empty queue" queue))
        ((null? (caddr (front-ptr queue)))
         (begin
           (set-cdr! queue nil)
           (set-car! queue nil)))
        (else
          (begin (set-car! queue (next-node (front-ptr queue)))
                 (set-car! (cdr (front-ptr queue)) nil)))))

(define (rear-delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "REAR-DELETE-QUEUE! called with an empty queue" queue))
        ((null? (cadr (rear-ptr queue)))
         (begin (set-cdr! queue nil)
                (set-car! queue nil)))
        (else
          (begin (set-cdr! queue (prev-node (rear-ptr queue)))
                 (set-cdr! (cdr (rear-ptr queue)) nil)))))


(define (front-queue queue)
  (value-node (front-ptr queue)))

(define (rear-queue queue)
  (value-node (rear-ptr queue)))

(define q1 (make-queue))


;; main
(define (main args)
  (disp "(print-queue q1): ")
  (print-queue q1)

  (disp "(empty-queue? q1): ")
  (print (empty-queue? q1))



  (print "(insert-queue! q1 'b)")
  (insert-queue! q1 'b)
  (disp "(print-queue q1): ")
  (print-queue q1)
  (print "(rear-insert-queue! q1 'c)")
  (rear-insert-queue! q1 'c)
  (disp "(print-queue q1): ")
  (print-queue q1)
  (print "(insert-queue! q1 'a)")
  (insert-queue! q1 'a)
  (disp "(print-queue q1): ")
  (print-queue q1)
  (print "(rear-insert-queue! q1 'd)")
  (rear-insert-queue! q1 'd)
  (disp "(print-queue q1): ")
  (print-queue q1)


  (disp "(front-queue q1): ")
  (print (front-queue q1))

  (disp "(rear-queue q1): ")
  (print (rear-queue q1))

  (disp "(empty-queue? q1): ")
  (print (empty-queue? q1))


  (disp "(rear-delete-queue! q1)")
  (rear-delete-queue! q1)
  (disp "(print-queue q1): ")
  (print-queue q1)
  (disp "(front-delete-queue! q1)")
  (front-delete-queue! q1)
  (disp "(print-queue q1): ")
  (print-queue q1)

  (disp "(front-queue q1): ")
  (print (front-queue q1))

  (disp "(rear-queue q1): ")
  (print (rear-queue q1))

  0)

実行！！

(print-queue q1): ()
(empty-queue? q1): #t
(insert-queue! q1 'b)
(print-queue q1): (b)
(rear-insert-queue! q1 'c)
(print-queue q1): (b c)
(insert-queue! q1 'a)
(print-queue q1): (a b c)
(rear-insert-queue! q1 'd)
(print-queue q1): (a b c d)
(front-queue q1): a
(rear-queue q1): d
(empty-queue? q1): #f
(rear-delete-queue! q1)(print-queue q1): (a b c)
(front-delete-queue! q1)(print-queue q1): (b c)
(front-queue q1): b
(rear-queue q1): c

多分あってる気がするんだけど、ソースがやたら長い。