SICPゼミ第18回

練習問題3.21

(define (print-queue queue)
      (display (car queue)))

Benはqueueの末尾のポインタを見てはっちゃけてるだけ。
by pine

練習問題3.22

(define (make-queue)
  (let (
      (front-ptr '())
      (rear-ptr '())
    )
    (define (empty-queue?) (null? front-ptr))
    (define (insert-queue item)
      (let ((paired (cons item '())))
        (if (empty-queue?)
            (begin (set! front-ptr paired)
              (set! rear-ptr paired))
          (begin (set-cdr! rear-ptr paired)
            (set! rear-ptr paired))
          )
        )
      )
    (define (delete-queue)
      (if (empty-queue?)
        (error "なにもない")
        (set! front-ptr (cdr front-ptr))
        )
      )
    (define (front-queue)
      (if (empty-queue?)
        (error "なにもない")
        (car front-ptr)
        )
      )
    (define (dispatch m)
        (cond
          ((eq? m 'insert) insert-queue)
          ((eq? m 'delete) (delete-queue))
          ((eq? m 'front) (front-queue))
          ((eq? m 'empty?) (empty-queue?))
          (else (error "そんな手続きはない"))
          )
        )
    dispatch
    )
  )

by dolicas

練習問題3.23

(define (front-ptr-deque queue) (car queue ))
(define (rear-ptr-deque queue) (cdr queue ))
(define (set-front-ptr-deque! queue item)
  (set-car! queue item))
(define (set-rear-ptr-deque! queue item)
  (set-cdr! queue item ))
(define (empty-deque? queue)
  (null? (front-ptr-deque queue)))

(define (make-deque) (cons '() '()))

(define (front-deque queue)
  (if (empty-deque? queue)
    (error "FRONT called with an empty queue" queue)
    (caar (front-ptr-deque queue))))

(define (rear-deque queue)
  (if (empty-deque? queue)
    (error "FRONT called with an empty queue" queue)
    (caar (rear-ptr-deque queue))))

(define (front-insert-deque! queue item)
  (let ((new-pair  (cons (cons item '()) (front-ptr-deque queue))))
    (cond ((empty-deque? queue)
            (set-front-ptr-deque! queue new-pair)
            (set-rear-ptr-deque! queue new-pair)
            queue)
    (else
      (set-cdr! (car (front-ptr-deque queue)) new-pair)
      (set-front-ptr-deque! queue new-pair)
      queue ))))

(define (rear-insert-deque! queue item)
  (let ((new-pair  (cons (cons item (rear-ptr-deque queue)) '())))
    (cond ((empty-deque? queue)
            (set-front-ptr-deque! queue new-pair)
            (set-rear-ptr-deque! queue new-pair) 
            queue)
    (else
      (set-cdr! (rear-ptr-deque queue) new-pair)
      (set-rear-ptr-deque! queue new-pair)
      queue ))))


(define (front-delete-deque! queue)
  (cond ((empty-deque? queue)
    (error "DELETE! called with an empty queue" queue ))
    (else (set-front-ptr-deque! queue (cdr (front-ptr-deque queue )))
queue )))

(define (rear-delete-deque! queue)
  (cond ((empty-deque? queue)
    (error "DELETE! called with an empty queue" queue ))
    (else (set-rear-ptr-deque! queue (cdar (rear-ptr-deque queue)))
queue )))

(define (print-deque deq)
  (define (print-iter item)
    (if (eq? item (rear-ptr-deque deq))
      (begin (display (caar item))
        (newline)
        )
      (begin (display (caar item))
        (display " ")
        (print-iter (cdr item))
        )
      )
    )
  (print-iter (car deq))
  )

(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-deque?) (null? front-ptr))
    (define (front-deque)
      (if (empty-deque?)
          (error "FRONT called with an empty queue")
          front-ptr))
    (define (rear-deque)
      (if (empty-deque?)
          (error "REAR called with an empty queue")
          rear-ptr))
    (define (front-insert-deque! item)
        (let ((new-pair (cons (cons item nil) nil)))
          (if (empty-deque?)
              (begin (set-front-ptr! new-pair) (set-rear-ptr! new-pair))
              (begin 
                (set-cdr! (car front-ptr) new-pair)
                (set-cdr! new-pair front-ptr)
                (set-front-ptr! new-pair)
                (print-deque)))))
    (define (front-delete-deque!)
      (if (empty-deque?)
          (error "Delete called with an empty queue")
          (begin
            (if (eq? front-ptr rear-ptr)
                (begin 
                  (set! front-ptr nil)
                  (set! rear-ptr nil))
                (begin
                  (set-front-ptr! (cdr front-ptr))
                  (set-cdr! (car front-ptr) nil)))
            (print-deque))))
    (define (rear-insert-deque! item)
        (let ((new-pair (cons (cons item nil) nil)))
          (if (empty-deque?)
              (begin (set-front-ptr! new-pair) (set-rear-ptr! new-pair))
              (begin 
                (set-cdr! (car new-pair) rear-ptr)
                (set-cdr! rear-ptr new-pair)
                (set-rear-ptr! new-pair)
                (print-deque)))))
    (define (rear-delete-deque!)
      (if (empty-deque?)
          (error "Delete called with an empty queue")
          (begin 
            (if (eq? front-ptr rear-ptr)
                (begin
                  (set! front-ptr nil)
                  (set! rear-ptr nil))
                (begin
                  (set-rear-ptr! (cdr (car rear-ptr)))
                  (set-cdr! rear-ptr nil)))
            (print-deque))))
    (define (print-deque)
      (define (print-deque-iter deque)
        (if (null? deque)
            nil
            (cons (caar deque) (print-deque-iter (cdr deque)))))
      (print-deque-iter front-ptr))
    (define (dispatch m)
      (cond ((eq? m 'set-front-ptr!) set-front-ptr!)
            ((eq? m 'set-rear-ptr!) set-rear-ptr!)
            ((eq? m 'empty-deque?) (empty-deque?))
            ((eq? m 'front-deque) (front-deque))
            ((eq? m 'rear-deque) (rear-deque))
            ((eq? m 'print-deque) (print-deque))
            ((eq? m 'front-insert-deque!) front-insert-deque!)
            ((eq? m 'front-delete-deque!) (front-delete-deque!))
            ((eq? m 'rear-insert-deque!) rear-insert-deque!)
            ((eq? m 'rear-delete-deque!) (rear-delete-deque!))))
    dispatch))

dispatch使ってついでにdeleteのコーナーケースに対応した版
by pine