sicp-3-3-2-representing-queues

#lang racket
(require racket/mpair)

;; queue implementation from book

(define (front-ptr queue) (mcar queue))
(define (rear-ptr queue) (mcdr queue))
(define (set-front-ptr! queue item) (set-mcar! queue item))
(define (set-rear-ptr! queue item) (set-mcdr! queue item))

(define (empty-queue? queue) (null? (front-ptr queue)))
(define (make-queue) (mcons '() '()))

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

(define (insert-queue! queue item)
  (define new-pair (mcons item '()))
  (cond [(empty-queue? queue)
         (set-front-ptr! queue new-pair)
         (set-rear-ptr! queue new-pair)
         queue]
        [else
          (set-mcdr! (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 (mcdr (front-ptr queue)))
          queue]))

;;;;;;;;;;
;; 3.21 ;;
;;;;;;;;;;

;; delete-queue! only changes the front pointer;  it does not affect the rear
;; pointer.  The rear pointer is only changed when we insert an element.

(define (print-queue queue)
  (for ([item (front-ptr queue)])
    (printf "~a " item))
  (printf "~n"))

;; tests

(define q (make-queue))
(insert-queue! q 'a)
;; (mcons (mcons 'a '()) (mcons 'a '()))
(insert-queue! q 'b)
;; (mcons (mcons 'a (mcons 'b '())) (mcons 'b '()))
(print-queue q)
;; a b
(front-queue q)
;; 'a
(delete-queue! q)
;; (mcons (mcons 'b '()) (mcons 'b '()))
(print-queue q)
;; b
(delete-queue! q)
;; (mcons '() (mcons 'b '()))
(empty-queue? q)
;; #t
q
;; (mcons '() (mcons 'b '()))
(print-queue q)
;;

;;;;;;;;;;
;; 3.22 ;;
;;;;;;;;;;

(define (make-procedural-queue)
  ; representation details
  (define front-ptr '())
  (define rear-ptr '())
  (define (set-front-ptr! item) (set! front-ptr item))
  (define (set-rear-ptr! item) (set! rear-ptr item))
  ; selectors
  (define (empty-queue?) (null? front-ptr))
  (define (front-queue)
    (if (empty-queue?)
      (error "FRONT called with an empty queue")
      (mcar front-ptr)))
  ; mutators
  (define (insert-queue! item)
    (define new-pair (mcons item '()))
    (cond [(empty-queue?)
           (set-front-ptr! new-pair)
           (set-rear-ptr! new-pair)
           (mcons front-ptr rear-ptr)]
          [else
            (set-mcdr! rear-ptr new-pair)
            (set-rear-ptr! new-pair)
            (mcons front-ptr rear-ptr)]))
  (define (delete-queue!)
    (cond [(empty-queue?)
           (error "DELETE! called with an empty queue")]
          [else
            (set-front-ptr! (mcdr front-ptr))
            (mcons front-ptr rear-ptr)]))
  ; display
  (define (print-queue)
    (for ([item front-ptr])
      (printf "~a " item))
    (printf "~n"))
  ; the queue procedure
  (define (dispatch m)
    (cond [(eq? m 'empty-queue?) (empty-queue?)]
          [(eq? m 'front-queue) (front-queue)]
          [(eq? m 'insert-queue!) insert-queue!]
          [(eq? m 'delete-queue!) (delete-queue!)]
          [(eq? m 'print-queue) (print-queue)]))
  dispatch)

;; tests

(define q1 (make-procedural-queue))
((q1 'insert-queue!) 'a)
;; (mcons (mcons 'a '()) (mcons 'a '()))
((q1 'insert-queue!) 'b)
;; (mcons (mcons 'a (mcons 'b '())) (mcons 'b '()))
(q1 'print-queue)
;; a b
(q1 'front-queue)
;; 'a
(q1 'delete-queue!)
;; (mcons (mcons 'b '()) (mcons 'b '()))
(q1 'print-queue)
;; b
(q1 'delete-queue!)
;; (mcons '() (mcons 'b '()))
(q1 'empty-queue?)
;; #t
(q1 'print-queue)
;;

;;;;;;;;;;
;; 3.23 ;;
;;;;;;;;;;

;; To get O(1) deque operations, we need a doubly-linked list.  To get a
;; doubly-linked list, I used triples (mcons x (mcons p1 p2)) where x is the
;; current list element, p1 is a pointer to the previous triple, and p2 is a
;; pointer to the next triple.

;; representation details
(define (front-deque-ptr deque) (mcar deque))
(define (rear-deque-ptr deque) (mcdr deque))
(define (set-front-deque-ptr! deque item) (set-mcar! deque item))
(define (set-rear-deque-ptr! deque item) (set-mcdr! deque item))

;; triples
(define (make-triple item) (mcons item (mcons empty empty)))
(define (previous-ptr triple) (mcar (mcdr triple)))
(define (next-ptr triple) (mcdr (mcdr triple)))
(define (set-previous-ptr! triple new-triple)
  (set-mcar! (mcdr triple) new-triple))
(define (set-next-ptr! triple new-triple)
  (set-mcdr! (mcdr triple) new-triple))

;; constructor
(define (make-deque) (mcons empty empty))
;; predicate
(define (empty-deque? deque) (empty? (front-deque-ptr deque)))

;; selectors
(define (front-deque deque)
  (if (empty-deque? deque)
    (error "FRONT called with an empty deque" deque)
    (mcar (front-deque-ptr deque))))
(define (rear-deque deque)
  (if (empty-deque? deque)
    (error "REAR called with an empty deque" deque)
    (mcar (rear-deque-ptr deque))))

;; mutators
(define (front-insert-deque! deque item)
  (define new-triple (make-triple item))
  (cond [(empty-deque? deque)
         (set-front-deque-ptr! deque new-triple)
         (set-rear-deque-ptr! deque new-triple)
         deque]
        [else
          (set-next-ptr! new-triple (front-deque-ptr deque))
          (set-previous-ptr! (front-deque-ptr deque) new-triple)
          (set-front-deque-ptr! deque new-triple)
          deque]))
(define (rear-insert-deque! deque item)
  (define new-triple (make-triple item))
  (cond [(empty-deque? deque)
         (set-front-deque-ptr! deque new-triple)
         (set-rear-deque-ptr! deque new-triple)
         deque]
        [else
          (set-previous-ptr! new-triple (rear-deque-ptr deque))
          (set-next-ptr! (rear-deque-ptr deque) new-triple)
          (set-rear-deque-ptr! deque new-triple)
          deque]))
(define (front-delete-deque! deque)
  (cond [(empty-deque? deque)
         (error "FRONT-DELETE! called with an empty deque" deque)]
        [(eq? (front-deque-ptr deque) (rear-deque-ptr deque))
         (set-front-deque-ptr! deque empty)
         (set-rear-deque-ptr! deque empty)
         deque]
        [else
          (set-previous-ptr! (next-ptr (front-deque-ptr deque)) empty)
          (set-front-deque-ptr! deque (next-ptr (front-deque-ptr deque)))
          deque]))
(define (rear-delete-deque! deque)
  (cond [(empty-deque? deque)
         (error "REAR-DELETE! called with an empty deque" deque)]
        [(eq? (front-deque-ptr deque) (rear-deque-ptr deque))
         (set-front-deque-ptr! deque empty)
         (set-rear-deque-ptr! deque empty)
         deque]
        [else
          (set-next-ptr! (previous-ptr (rear-deque-ptr deque)) empty)
          (set-rear-deque-ptr! deque (previous-ptr (rear-deque-ptr deque)))
          deque]))

(define (print-deque deque)
  (define (loop triple)
    (printf "~a " (mcar triple))
    (define next-triple (next-ptr triple))
    (if (not (empty? next-triple))
      (loop next-triple)
      (printf "~n")))
  (if (empty-deque? deque)
    (printf "~n")
    (loop (front-deque-ptr deque))))

;; tests

(define d (make-deque))
(print-deque (front-insert-deque! d 'a))
;; a
(print-deque (front-insert-deque! d 'b))
;; b a
(print-deque (rear-insert-deque! d 'c))
;; b a c
(front-deque d)
;; 'b
(rear-deque d)
;; 'c
(print-deque (rear-delete-deque! d))
;; b a
(print-deque (front-delete-deque! d))
;; a
(print-deque (rear-delete-deque! d))
;;
(empty-deque? d)
;; #t