2015/11/20

# SICP 問題 3.23

``````;; dequeの実装
(define (value-ptr ptr) (caar ptr))
(define (prev-ptr ptr) (cdar ptr))
(define (next-ptr ptr) (cdr ptr))

;; ((value))というリストを作る
(define (make-ptr value) (list (list value)))

(define (make-queue)
(cons '() '()))

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

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

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

(define (make-empty-queue queue)
(set-front-ptr! queue '())
(set-rear-ptr! queue '())
queue)

(define (printing queue)
(let recur ((deque (front-ptr queue)))
(cond ((null? deque) '())
(else
(cons (value-ptr deque)
(recur (next-ptr deque)))))))

(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (set-prev-ptr! ptr item) (set-cdr! (car ptr) item))
(define (set-next-ptr! ptr item) (set-cdr! ptr item))

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

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

(define (front-delete-queue! queue)
(cond ((empty-queue? queue)
(error "FRONT-DELETE! called with an empty queue" queue))
(else
(let* ((old-front-ptr (front-ptr queue))
(new-front-ptr (next-ptr old-front-ptr)))
(cond ((null? new-front-ptr)
(make-empty-queue queue)
(value-ptr old-front-ptr))
(else
(set-next-ptr! old-front-ptr
'())
(set-prev-ptr! new-front-ptr
'())
(set-front-ptr! queue new-front-ptr)
(value-ptr old-front-ptr)))))))

(define (rear-delete-queue! queue)
(cond ((empty-queue? queue)
(error "REAR-DELETE! called with an empty queue" queue))
(else
(let ((new-rear-ptr (prev-ptr (rear-ptr queue)))
(old-rear-ptr (rear-ptr queue)))
(cond ((null? new-rear-ptr)
(make-empty-queue queue)
(value-ptr old-rear))
(else
(set-prev-ptr! old-rear-ptr
'())
(set-next-ptr! new-rear-ptr
'())
(set-rear-ptr! queue new-rear-ptr)
(value-ptr old-rear-ptr)))))))
``````
``````gosh> (define q1 (make-queue))
q1
gosh> (printing q1)
()
gosh> (front-insert-queue! q1 'a)
ok
gosh> (printing q1)
(a)
gosh> (front-insert-queue! q1 'b)
ok
gosh> (printing q1)
(b a)
gosh> (front-insert-queue! q1 'c)
ok
gosh> (printing q1)
(c b a)
gosh> (front-delete-queue! q1)
c
gosh> (printing q1)
(b a)
gosh> (front-delete-queue! q1)
b
gosh> (front-delete-queue! q1)
ok
gosh> (printing q1)
()
gosh> (define q1 (make-queue))
q1
gosh> (printing q1)
()
gosh> (front-insert-queue! q1 'a)
ok
gosh> (printing q1)
(a)
gosh> (front-insert-queue! q1 'b)
ok
gosh> (printing q1)
(b a)
gosh> (front-insert-queue! q1 'c)
ok
gosh> (printing q1)
(c b a)
gosh> (front-delete-queue! q1)
c
gosh> (printing q1)
(b a)
gosh> (front-delete-queue! q1)
b
gosh> (printing q1)
(a)
gosh> (front-delete-queue! q1)
a
gosh> (printing q1)
()
gosh> (rear-insert-queue! q1 'a)
ok
gosh> (printing q1)
(a)
gosh> (rear-insert-queue! q1 'b)
ok
gosh> (printing q1)
(a b)
gosh> (rear-insert-queue! q1 'c)
ok
gosh> (printing q1)
(a b c)
gosh> (rear-delete-queue! q1)
c
gosh> (printing q1)
(a b)
gosh> (rear-delete-queue! q1)
b
gosh> (printing q1)
(a)
gosh> (rear-delete-queue! q1)
a
gosh> (printing q1)
()``````