(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 (front-queue queue)
(if (empty-queue? queue)
(error "FRONT called with an empty queue" queue)
(car (front-ptr queue))))
(define (insert-queue! queue item)
(let ((new-pair (cons item '())))
(cond ((empty-queue? queue)
(set-front-ptr! queue new-pair)
(set-rear-ptr! queue new-pair)
queue)
(else
(set-cdr! (rear-ptr queue) new-pair)
(set-rear-ptr! queue new-pair)
queue))))
(define (delete-queue! queue)
(cond ((empty-queue? queue)
(error "DELETE! called with an empty queue" queue))
(else
(set-front-ptr! queue (cdr (front-ptr queue)))
queue)))
3.21 (キューの印字)
(define (print-queue queue) (display (front-ptr queue)) (newline))
3.22
(define (make-queue)
(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)
(if (empty-queue?)
(error "FRONT called with an empty queue")
(car front-ptr)))
(define (insert! item)
(let ((new-pair (cons item '())))
(cond ((empty-queue?)
(set-front-ptr! new-pair)
(set-rear-ptr! new-pair))
(else
(set-cdr! rear-ptr new-pair)
(set-rear-ptr! new-pair)))))
(define (delete!)
(cond ((empty-queue?)
(error "DELETE! called with an empty queue"))
(else
(set-front-ptr! (cdr front-ptr)))))
(define (dispatch m)
(cond ((eq? m 'insert!) insert!)
((eq? m 'delete!) delete!)
((eq? m 'front) front)
(else (error "No such method " m))))
dispatch))
3.23 (dequeの実装)
どうしても綺麗な実装が思い付かなかった…orz
(define nil '())
(define (make-deque)
(cons (cons '() '())
(cons '() '())))
(define (deque-front-pointer deque)
(caar deque))
(define (deque-back-pointer deque)
(cdar deque))
(define (deque-reverse-front-pointer deque)
(cadr deque))
(define (deque-reverse-back-pointer deque)
(cddr deque))
(define (deque-set-front! deque x)
(set-car! (car deque) x))
(define (deque-set-back! deque x)
(set-cdr! (car deque) x))
(define (deque-set-reverse-front! deque x)
(set-car! (cdr deque) x))
(define (deque-set-reverse-back! deque x)
(set-cdr! (cdr deque) x))
(define (print-deque deque)
(display (deque-front-pointer deque))
(newline))
(define (deque-null? deque)
(null? (deque-front-pointer deque)))
(define (deque-front deque)
(if (deque-null? deque)
(error "deque is null")
(car (deque-front-pointer deque))))
(define (deque-back deque)
(if (deque-null? deque)
(error "deque is null")
(car (deque-back-pointer deque))))
(define (deque-set-singleton! deque x)
(let ((forward-queue (cons x nil)))
(deque-set-front! deque forward-queue)
(deque-set-back! deque forward-queue)
(let ((reverse-queue (cons (deque-front-pointer deque) nil)))
(deque-set-reverse-front! deque reverse-queue)
(deque-set-reverse-back! deque reverse-queue))))
(define (deque-push-front! deque x)
(if (deque-null? deque)
(deque-set-singleton! deque x)
(begin
(deque-set-front! deque (cons x (deque-front-pointer deque)))
(let ((new-reverse-back (cons (deque-front-pointer deque) nil)))
(set-cdr! (deque-reverse-back-pointer deque) new-reverse-back)
(deque-set-reverse-back! deque new-reverse-back)))))
(define (deque-pop-front! deque)
(if (deque-null? deque)
(error "deque is null")
(let ((front (deque-front deque)))
(deque-set-front! deque (cdr (deque-front-pointer deque)))
front)))
(define (deque-push-back! deque x)
(if (deque-null? deque)
(deque-set-singleton! deque x)
(let ((new-back (cons x nil)))
(set-cdr! (deque-back-pointer deque) new-back)
(deque-set-back! deque new-back)
(deque-set-reverse-front! deque (cons (deque-back-pointer deque) (deque-reverse-front-pointer deque))))))
(define (deque-pop-back! deque)
(if (deque-null? deque)
(error "deque is null")
(let ((back (deque-back deque)))
(deque-set-reverse-front! deque (cdr (deque-reverse-front-pointer deque)))
(if (null? (deque-reverse-front-pointer deque))
(deque-set-front! deque nil)
(begin
(deque-set-back! deque (car (deque-reverse-front-pointer deque)))
(set-cdr! (deque-back-pointer deque) nil)))
back)))
