SICP 問題 3.23
対を使って前後へのポインタを持ったdequeを実装する.
;; 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) ()