Chat (Lingr.com)
Informaiton
Daily
Column
- MySQL日本語の旅(5/1)
- アクセス向上秘伝(5/9)
- 一風変ったHaskellλ門(6/13)
- SICP Answer Book (5/31) 問題3.26追加
Zope Solution
Extra
アーカイブ
OSS案内所
Site Info
関連リンク
##(link2sicp "book-Z-H-22.html#%_thm_3.23" "Exercise 3.23")
higeponさんから解答が寄せられました． ありがとうございます．
解答例
(define (make-deque)
(let ((front-ptr '())
(rear-ptr '()))
(define (set-front-ptr! item) (set! front-ptr item))
(define (set-rear-ptr! item) (set! rear-ptr item))
(define (empty-queue?) (null? front-ptr))
(define (front-queue)
(if (empty-queue?)
(error "FRONT called with an empty queue")
front-ptr))
(define (rear-queue)
(if (empty-queue?)
(error "REAR called with an empty queue")
rear-ptr))
(define (front-insert-queue! item)
(let ((new-pair (cons (cons item '()) front-ptr)))
(cond ((empty-queue?)
(set-front-ptr! new-pair)
(set-rear-ptr! new-pair)
(print-queue))
(else
(set-cdr! (car front-ptr) new-pair)
(set-front-ptr! new-pair)
(print-queue)))))
(define (rear-insert-queue! item)
(let ((new-pair (cons (cons item rear-ptr) '())))
(cond ((empty-queue?)
(set-front-ptr! new-pair)
(set-rear-ptr! new-pair)
(print-queue))
(else
(set-cdr! rear-ptr new-pair)
(set-rear-ptr! new-pair)
(print-queue)))))
(define (front-delete-queue!)
(cond ((empty-queue?)
(error "DELETE! called with an empty queue"))
((null? (cdr front-ptr))
(set-front-ptr! '())
(set-rear-ptr! '()))
(else
(set-front-ptr! (cdr front-ptr))
(set-cdr! (car front-ptr) '())
(if (empty-queue?)
'empty-queue
(print-queue)))))
(define (rear-delete-queue!)
(cond ((empty-queue?)
(error "DELETE! called with an empty queue"))
((null? (cdr front-ptr))
(set-front-ptr! '())
(set-rear-ptr! '()))
(else
(set-rear-ptr! (cdr (car rear-ptr)))
(set-cdr! rear-ptr '())
(if (empty-queue?)
'empty-queue
(print-queue)))))
(define (print-queue)
(do ((x front-ptr (cdr x)))
((null? x) (newline))
(begin
(display (caar x))
(display " "))))
(define (dispatch m)
(cond ((eq? m 'front-insert!) front-insert-queue!)
((eq? m 'rear-insert!) rear-insert-queue!)
((eq? m 'front-delete!) (front-delete-queue!))
((eq? m 'rear-delete!) (rear-delete-queue!))
((eq? m 'front) (front-queue))
((eq? m 'rear) (rear-queue))
((eq? m 'empty?) (empty?-queue))
((eq? m 'print) (print-queue))
(else
(error "Undefined operation -- DISPATCH" m))))
dispatch))
(define (front-insert-queue! queue item) ((queue 'front-insert!) item))
(define (rear-insert-queue! queue item) ((queue 'rear-insert!) item))
(define (front-delete-queue! queue) (queue 'front-delete!))
(define (rear-delete-queue! queue) (queue 'rear-delete!))
(define (front-queue queue) (queue 'front))
(define (rear-queue queue) (queue 'rear))
(define (empty-queue? queue) (queue 'empty?))
(define (print-queue queue) (queue 'print))
実行例
gosh> (define dq (make-deque)) dq gosh> (front-insert-queue! dq 'c) c #<undef> gosh> (front-insert-queue! dq 'b) b c #<undef> gosh> (front-insert-queue! dq 'a) a b c #<undef> gosh> (rear-insert-queue! dq 'd) a b c d #<undef> gosh> (rear-insert-queue! dq 'e) a b c d e #<undef> gosh> (front-delete-queue! dq) b c d e #<undef> gosh> (rear-delete-queue! dq) b c d #<undef> gosh> (front-delete-queue! dq) c d #<undef> gosh> (rear-delete-queue! dq) c #<undef> gosh> (rear-delete-queue! dq) () gosh> (front-delete-queue! dq) *** ERROR: DELETE! called with an empty queue
--hidenao
コード
##(sicp-answer-code "ex-3.23.scm")
higepon さんからの解答例と解説
解説
O(1)を達成するというのがこの問題のやっかいなところです。 問題3.21の構造のままでfront-insert/rear-insert/front-deleteは O(1)を達 成できます。
しかし rear-delete は O(n) となってしまいます。 rear-ptrのセットのために後ろから2番目にある要素を先頭から順に探さなけ ればいけないからです。
そこで、データの構造を双方向リストにして O(1) を達成します。 (make-item)で作った item に対して next-item/prev-item で次の要素/前の 要素を取得できるようにしています。
(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))
(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (cons '() '()))
(define (make-item value)
(cons value (cons '() '())))
(define (set-next-item! item next)
(set-cdr! (cdr item) next))
(define (next-item item)
(cddr item))
(define (prev-item item)
(cadr item))
(define (set-prev-item! item prev)
(set-car! (cdr item) prev))
(define (value-of-item item)
(car item))
(define (front-queue queue)
(if (empty-queue? queue)
(error "empty queue")
((value-of-item (front-ptr queue)))))
(define (rear-queue queue)
(if (empty-queue? queue)
(error "empty queue")
((value-of-item (rear-ptr queue)))))
(define (rear-insert-queue! queue value)
(let ((new-item (make-item value)))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-item)
(set-rear-ptr! queue new-item)
queue)
(else
(set-prev-item! new-item (rear-ptr queue))
(set-next-item! (rear-ptr queue) new-item)
(set-rear-ptr! queue new-item)
queue))))
(define (front-insert-queue! queue value)
(let ((new-item (make-item value)))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-item)
(set-rear-ptr! queue new-item)
queue)
(else
(set-next-item! new-item (front-ptr queue))
(set-front-ptr! queue new-item)
queue))))
(define (front-delete-queue! queue)
(cond ((empty-queue? queue)
(error "empty queue"))
(else
(set-front-ptr! queue (next-item (front-ptr queue)))
queue)))
(define (rear-delete-queue! queue)
(cond ((empty-queue? queue)
(error "empty queue"))
(else
(set-rear-ptr! queue (prev-item (rear-ptr queue)))
queue)))
(define (display-queue queue)
(define (display-queue-internal q)
(cond ((eq? q (rear-ptr queue))
(display " ")
(display (value-of-item q)))
(else
(begin (display " ")
(display (value-of-item q))
(display-queue-internal (next-item q))))))
(if (empty-queue? queue)
(display "empty queue\n")
(begin
(display "(")
(display-queue-internal (front-ptr queue))
(display ")\n"))))
実行例
gosh> (define q1 (make-queue)) gosh> (display-queue q1) empty queue gosh> (rear-insert-queue! q1 'b) gosh> (display-queue q1) ( b) gosh> (front-insert-queue! q1 'a) gosh> (display-queue q1) ( a b) gosh> (rear-insert-queue! q1 'c) (display-queue q1) gosh> ( a b c) gosh> (front-insert-queue! q1 'Z) (display-queue q1) (front-delete-queue! q1) gosh> ( Z a b c) gosh> ((a () . #0=(b () . #1=(c #0#))) . #1#) gosh> (display-queue q1) ( a b c) gosh> (rear-delete-queue! q1) gosh> (display-queue q1) ( a b)
higepon さんのコード
##(sicp-answer-code "ex-3.23-higepon.scm")
