SICP 読み (108) 3.3.2 キューの表現
double-ended queue な課題
問題 3.23
以下の手続きがあれば良い、と。
- make-deque
- empty-deque?
- front-deque
- rear-deque
- front-insert-deque!
- rear-insert-deque!
- front-delete-deque!
- rear-delete-deque!
とりあえず元のソレをコピって作ってみるか、とゆー事で以下が試験ですが、(106) の差分のみ。
("rear-queue test"
("empty-queue"
(assert-error (lambda() (rear-queue '(()))))
)
("normal"
(let ((q (cons (cons 1 '()) '())))
(assert-equal 1 (rear-queue q)))
)
)あと、insert! とか delete! のあたりは以下のように。
("front-insert-queue! test"
("front-insert"
(let ((q (make-queue)))
(front-insert-queue! q 1)
(assert-equal 1 (front-queue q))
(assert-equal 1 (rear-queue q))
(front-insert-queue! q 2)
(assert-equal 2 (front-queue q))
(assert-equal 1 (rear-queue q))
(front-insert-queue! q 3)
(assert-equal 3 (front-queue q))
(assert-equal 1 (rear-queue q))
(front-insert-queue! q 4)
(assert-equal 4 (front-queue q))
(assert-equal 1 (rear-queue q))
)
)
)
("rear-insert-queue! test"
("rear-insert"
(let ((q (make-queue)))
(rear-insert-queue! q 1)
(assert-equal 1 (front-queue q))
(assert-equal 1 (rear-queue q))
(rear-insert-queue! q 2)
(assert-equal 1 (front-queue q))
(assert-equal 2 (rear-queue q))
(rear-insert-queue! q 3)
(assert-equal 1 (front-queue q))
(assert-equal 3 (rear-queue q))
(rear-insert-queue! q 4)
(assert-equal 1 (front-queue q))
(assert-equal 4 (rear-queue q))
)
)
)
("front-delete-queue! test"
("front-delete"
(let ((q (make-queue)))
(rear-insert-queue! q 1)
(rear-insert-queue! q 2)
(assert-equal 1 (front-queue q))
(front-delete-queue! q)
(assert-equal 2 (front-queue q))
(rear-insert-queue! q 3)
(assert-equal 2 (front-queue q))
(front-delete-queue! q)
(assert-equal 3 (front-queue q))
(front-delete-queue! q)
(assert-true (empty-queue? q)))
)
)
("rear-delete-queue! test"
("rear-delete"
(let ((q (make-queue)))
(front-insert-queue! q 1)
(front-insert-queue! q 2)
(assert-equal 2 (front-queue q))
(rear-delete-queue! q)
(assert-equal 1 (front-queue q))
(front-insert-queue! q 3)
(assert-equal 3 (front-queue q))
(rear-delete-queue! q)
(assert-equal 1 (front-queue q))
(rear-delete-queue! q)
(assert-true (empty-queue? q)))
)
)うーん。なんか微妙。がしかし構わず実装に移る。
続き
って全部 O(1) で処理するってコトは、これまでに出てきた queue の実装だと rear-delete がどうにもならんぞ。つーコトは上記の試験では微妙だな。双方向リストだったら簡単、とゆーのは想像に難くないんですがどうすりゃ良いやら。
あるいは、insert する時の先頭 (又は末端) は保管しとく、とか?? (なんか微妙
# げ。これじゃ二コ前の末端とか分からんし。(駄目
とりあえず動きそうな感じのアイデアをひり出しはしたのですが、試験はそのままで (とは言え queue を deque にしてます)。
そのまた続き
O(1) にしろ、とゆーのはキビシいな。直上で_動きそう_と書いたソレは結局の所、削除において O(n) になる事が判明。無理矢理双方向リストをでっち上げる事に。
基本的には car には値で、cdr に前と後の要素へのポインタ、な方向で。
以下が試験
#!/usr/bin/env gosh
(use test.unit)
(require "3.3.2")
(define-test-suite "3.3.2"
("make-deque test"
("(make-deque) returns '(())"
(assert-equal '(()) (make-deque))
)
("(front-ptr (make-deque)) returns '()"
(let ((q (make-deque)))
(assert-equal '() (front-ptr q)))
)
("(rear-ptr (make-deque)) returns '()"
(let ((q (make-deque)))
(assert-equal '() (rear-ptr q)))
)
("empty-deque? returns true"
(let ((q (make-deque)))
(assert-true (empty-deque? q)))
)
("front-deque error"
(let ((q (make-deque)))
(assert-error (lambda () (front-deque q))))
)
("rear-deque error"
(let ((q (make-deque)))
(assert-error (lambda () (rear-deque q))))
)
)
("front-ptr test"
("return (car deque)"
(assert-equal 'car (front-ptr (cons 'car 'cdr)))
)
)
("rear-ptr test"
("return (cdr deque)"
(assert-equal 'cdr (rear-ptr (cons 'car 'cdr)))
)
)
("set-front-ptr! test"
("set-car!"
(let ((q (cons 'car 'cdr)))
(set-front-ptr! q 'change)
(assert-equal 'change (front-ptr q)))
)
)
("set-rear-ptr! test"
("set-cdr!"
(let ((q (cons 'car 'cdr)))
(set-rear-ptr! q 'change)
(assert-equal 'change (rear-ptr q)))
)
)
("empty-deque? test"
("empty"
(assert-true (empty-deque? '(())))
)
("not empty"
(assert-false (empty-deque? (cons 'a '())))
)
)
("front-deque test"
("empty deque"
(assert-error (lambda () (front-deque '(()))))
)
("normal"
(let ((i (cons 1 (cons '() '()))))
(let ((q (cons i i)))
(assert-equal 1 (front-deque q))))
)
)
("rear-deque test"
("empty-deque"
(assert-error (lambda() (rear-deque '(()))))
)
("normal"
(let ((i (cons 1 (cons '() '()))))
(let ((q (cons i i)))
(assert-equal 1 (rear-deque q))))
)
)
("front-insert-deque! test"
("front-insert"
(let ((q (make-deque)))
(front-insert-deque! q 1)
(assert-equal 1 (front-deque q))
(assert-equal 1 (rear-deque q))
(front-insert-deque! q 2)
(assert-equal 2 (front-deque q))
(assert-equal 1 (rear-deque q))
(front-insert-deque! q 3)
(assert-equal 3 (front-deque q))
(assert-equal 1 (rear-deque q))
(front-insert-deque! q 4)
(assert-equal 4 (front-deque q))
(assert-equal 1 (rear-deque q))
)
)
)
("rear-insert-deque! test"
("rear-insert"
(let ((q (make-deque)))
(rear-insert-deque! q 1)
(assert-equal 1 (front-deque q))
(assert-equal 1 (rear-deque q))
(rear-insert-deque! q 2)
(assert-equal 1 (front-deque q))
(assert-equal 2 (rear-deque q))
(rear-insert-deque! q 3)
(assert-equal 1 (front-deque q))
(assert-equal 3 (rear-deque q))
(rear-insert-deque! q 4)
(assert-equal 1 (front-deque q))
(assert-equal 4 (rear-deque q))
)
)
)
("front-delete-deque! test"
("front-delete"
(let ((q (make-deque)))
(rear-insert-deque! q 1)
(rear-insert-deque! q 2)
(assert-equal 1 (front-deque q))
(front-delete-deque! q)
(assert-equal 2 (front-deque q))
(rear-insert-deque! q 3)
(assert-equal 2 (front-deque q))
(front-delete-deque! q)
(assert-equal 3 (front-deque q))
(front-delete-deque! q)
(assert-true (empty-deque? q)))
)
)
("rear-delete-deque! test"
("rear-delete"
(let ((q (make-deque)))
(front-insert-deque! q 1)
(front-insert-deque! q 2) ;; 2 -> 1
(assert-equal 2 (front-deque q))
(rear-delete-deque! q) ;; 2
(assert-equal 2 (front-deque q))
(front-insert-deque! q 3) ;; 3 -> 2
(assert-equal 3 (front-deque q))
(rear-delete-deque! q) ;; 3
(assert-equal 3 (front-deque q))
(rear-delete-deque! q) ;;
(assert-true (empty-deque? q)))
)
)
)で、微妙な実装が以下。DRY 違反満載
(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 (empty-deque? deque) (null? (front-ptr deque)))
(define (make-deque) (cons '() '()))
(define (front-deque deque)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(car (front-ptr deque))))
(define (rear-deque deque)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(car (rear-ptr deque))))
(define (front-insert-deque! deque item)
(let ((new-pair (cons item (cons '() '()))))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-pair)
(set-rear-ptr! deque new-pair)
deque)
(else
(set-car! (cdr (front-ptr deque)) new-pair)
(set-cdr! (cdr new-pair) (front-ptr deque))
(set-front-ptr! deque new-pair)
deque))))
(define (rear-insert-deque! deque item)
(let ((new-pair (cons item (cons '() '()))))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-pair)
(set-rear-ptr! deque new-pair)
deque)
(else
(set-car! (cdr new-pair) (rear-ptr deque))
(set-cdr! (cdr (rear-ptr deque)) new-pair)
(set-rear-ptr! deque new-pair)
deque))))
(define (front-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
(else
(cond ((eq? (front-ptr deque) (rear-ptr deque))
(set-front-ptr! deque '())
(set-rear-ptr! deque '())
deque)
(else
(set-front-ptr! deque (cdr (cdr (front-ptr deque))))
deque)))))
(define (rear-delete-deque! deque)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
(else
(cond ((eq? (front-ptr deque) (rear-ptr deque))
(set-front-ptr! deque '())
(set-rear-ptr! deque '())
deque)
(else
(set-rear-ptr! deque (car (cdr (rear-ptr deque))))
deque)))))
(define (print-deque q)
(let f ((q (front-ptr q)) (l '()))
(if (null? (cdr (cdr q)))
l
(f (cdr (cdr q)) (cons (car q) l)))))別途、もう少し見直しが必要。
さらに追記
面白そうなんで見直し。
(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 (empty-deque? deque) (null? (front-ptr deque)))
(define (make-deque) (cons '() '()))
(define (end-deque deque p)
(if (empty-deque? deque)
(error "FRONT called with an empty deque" deque)
(car (p deque))))
(define (front-deque deque)
(end-deque deque front-ptr))
(define (rear-deque deque)
(end-deque deque rear-ptr))
(define (insert-deque-common deque item p)
(let ((new-pair (cons item (cons '() '()))))
(cond ((empty-deque? deque)
(set-front-ptr! deque new-pair)
(set-rear-ptr! deque new-pair)
deque)
(else
(p deque new-pair)
deque))))
(define (front-insert-deque! deque item)
(insert-deque-common deque item
(lambda (deque new-pair)
(set-car! (cdr (front-ptr deque)) new-pair)
(set-cdr! (cdr new-pair) (front-ptr deque))
(set-front-ptr! deque new-pair))))
(define (rear-insert-deque! deque item)
(insert-deque-common deque item
(lambda (deque new-pair)
(set-car! (cdr new-pair) (rear-ptr deque))
(set-cdr! (cdr (rear-ptr deque)) new-pair)
(set-rear-ptr! deque new-pair))))
(define (delete-queue-common deque p)
(cond ((empty-deque? deque)
(error "DELETE! called with an empty deque" deque))
(else
(cond ((eq? (front-ptr deque) (rear-ptr deque))
(set-front-ptr! deque '())
(set-rear-ptr! deque '())
deque)
(else
(p deque)
deque)))))
(define (front-delete-deque! deque)
(delete-queue-common deque
(lambda (deque)
(set-front-ptr! deque
(cdr (cdr (front-ptr deque)))))))
(define (rear-delete-deque! deque)
(delete-queue-common deque
(lambda (deque)
(set-rear-ptr! deque
(car (cdr (rear-ptr deque)))))))
(define (print-deque q)
(let f ((q (front-ptr q)) (l '()))
(if (null? q)
l
(f (cdr (cdr q)) (cons (car q) l)))))まだ微妙。
