2020-12-19 15:22:30 +01:00
|
|
|
(load "util.scm")
|
|
|
|
|
|
|
|
(display "\nexample - queue\n")
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
|
|
|
|
(define q (make-queue))
|
|
|
|
(insert-queue! q 'a)
|
|
|
|
(insert-queue! q 'b)
|
|
|
|
(delete-queue! q)
|
|
|
|
(insert-queue! q 'c)
|
|
|
|
(insert-queue! q 'd)
|
|
|
|
(delete-queue! q)
|
|
|
|
|
|
|
|
(display "\nex-3.21 - print queue\n")
|
|
|
|
|
|
|
|
(define print-queue front-ptr)
|
|
|
|
|
|
|
|
(define q1 (make-queue))
|
|
|
|
(assert (print-queue (insert-queue! q1 'a)) '(a))
|
|
|
|
(assert (print-queue (insert-queue! q1 'b)) '(a b))
|
|
|
|
(assert (print-queue (delete-queue! q1)) '(b))
|
|
|
|
(assert (print-queue (delete-queue! q1)) '())
|
|
|
|
|
|
|
|
|
|
|
|
(display "\nex-3.22 - procedural queue\n")
|
|
|
|
|
|
|
|
(define (make-queue)
|
|
|
|
(let ((front-ptr '())
|
|
|
|
(rear-ptr '()))
|
|
|
|
(define (empty-queue?) (null? front-ptr))
|
|
|
|
(define (insert-queue! item)
|
|
|
|
(let ((new-pair (cons item '())))
|
|
|
|
(cond ((empty-queue?)
|
|
|
|
(set! front-ptr new-pair)
|
|
|
|
(set! rear-ptr new-pair)
|
|
|
|
dispatch)
|
|
|
|
(else
|
|
|
|
(set-cdr! rear-ptr new-pair)
|
|
|
|
(set! rear-ptr new-pair)
|
|
|
|
dispatch))))
|
|
|
|
(define (delete-queue!)
|
|
|
|
(cond ((empty-queue?)
|
|
|
|
(error "DELETE! called with an empty queue" queue))
|
|
|
|
(else
|
|
|
|
(set! front-ptr (cdr front-ptr))
|
|
|
|
dispatch)))
|
|
|
|
(define (dispatch m)
|
|
|
|
(cond
|
|
|
|
((eq? m 'insert) insert-queue!)
|
|
|
|
((eq? m 'delete) delete-queue!)
|
|
|
|
((eq? m 'print) (lambda () front-ptr))
|
|
|
|
(else (error "Undefined operation -- DISPATCH-QUEUE" m))))
|
|
|
|
dispatch)))
|
|
|
|
|
|
|
|
(define q (make-queue))
|
|
|
|
((q 'insert) 'a)
|
|
|
|
((q 'insert) 'b)
|
|
|
|
((q 'insert) 'c)
|
|
|
|
((q 'insert) 'd)
|
|
|
|
(assert ((q 'print)) '(a b c d))
|
|
|
|
((q 'delete))
|
|
|
|
((q 'delete))
|
|
|
|
(assert ((q 'print)) '(c d))
|
|
|
|
|
2020-12-20 13:10:04 +01:00
|
|
|
(display "\nex-3.23 - deque\n")
|
2020-12-19 15:22:30 +01:00
|
|
|
|
|
|
|
; A deque (``double-ended queue'') is a sequence in which items can be inserted
|
|
|
|
; and deleted at either the front or the rear. Show how to represent deques
|
|
|
|
; using pairs, and give implementations of the operations.23 All operations
|
|
|
|
; should be accomplished in (1) steps.
|
|
|
|
|
2020-12-20 13:10:04 +01:00
|
|
|
(define (front-ptr deque) (car deque))
|
|
|
|
(define (rear-ptr deque) (cdr deque))
|
|
|
|
(define (set-front-ptr! queue item) (set-car! queue item))
|
|
|
|
(define (set-rear-ptr! queue item) (set-cdr! queue item))
|
|
|
|
|
|
|
|
(define (make-deque) (cons '() '()))
|
|
|
|
(define (empty-deque? deque) (null? (front-ptr deque)))
|
|
|
|
|
|
|
|
(define (make-node item prev-ptr next-ptr)
|
|
|
|
(cons item (cons prev-ptr next-ptr)))
|
|
|
|
|
|
|
|
(define (set-prev-node! node prev-ptr)
|
|
|
|
(set-car! (cdr node) prev-ptr))
|
|
|
|
|
|
|
|
(define (set-next-node! node next-ptr)
|
|
|
|
(set-cdr! (cdr node) next-ptr))
|
|
|
|
|
|
|
|
(define (prev-node node) (car (cdr node)))
|
|
|
|
(define (next-node node) (cdr (cdr node)))
|
|
|
|
|
|
|
|
(define (display-deque deque)
|
|
|
|
(define (iter-nodes node)
|
|
|
|
(if (null? node)
|
|
|
|
'done
|
|
|
|
(begin
|
|
|
|
(display (car node))
|
|
|
|
(if (null? (next-node node))
|
|
|
|
'do-nothing
|
|
|
|
(display ", "))
|
|
|
|
(iter-nodes (next-node node)))))
|
|
|
|
(display "[")
|
|
|
|
(iter-nodes (front-ptr deque))
|
|
|
|
(display "]\n"))
|
|
|
|
|
|
|
|
(define (front-deque deque)
|
|
|
|
(if (empty-deque? deque)
|
|
|
|
(error "FRONT called with an empty deque")
|
|
|
|
(car (front-ptr deque))))
|
|
|
|
|
|
|
|
(define (rear-deque deque)
|
|
|
|
(if (empty-deque? deque)
|
|
|
|
(error "REAR called with an empty deque")
|
|
|
|
(car (rear-ptr deque))))
|
|
|
|
|
|
|
|
(define (front-insert-deque! deque item)
|
|
|
|
(let ((new-node (make-node item '() '())))
|
|
|
|
(cond ((empty-deque? deque)
|
|
|
|
(set-front-ptr! deque new-node)
|
|
|
|
(set-rear-ptr! deque new-node)
|
|
|
|
deque)
|
|
|
|
(else
|
|
|
|
(set-next-node! new-node (front-ptr deque))
|
|
|
|
(set-prev-node! (front-ptr deque) new-node)
|
|
|
|
(set-front-ptr! deque new-node)
|
|
|
|
deque))))
|
|
|
|
|
|
|
|
(define (rear-insert-deque! deque item)
|
|
|
|
(let ((new-node (make-node item '() '())))
|
|
|
|
(cond ((empty-deque? deque)
|
|
|
|
(set-front-ptr! deque new-node)
|
|
|
|
(set-rear-ptr! deque new-node)
|
|
|
|
deque)
|
|
|
|
(else
|
|
|
|
(set-prev-node! new-node (rear-ptr deque))
|
|
|
|
(set-next-node! (rear-ptr deque) new-node)
|
|
|
|
(set-rear-ptr! deque new-node)
|
|
|
|
deque))))
|
|
|
|
|
|
|
|
(define (front-delete-deque! deque)
|
|
|
|
(cond ((empty-deque? deque)
|
|
|
|
(error "DELETE! called with an empty deque" deque))
|
2020-12-21 21:16:32 +01:00
|
|
|
((null? (next-node (front-ptr deque)))
|
|
|
|
(set-front-ptr! deque '())
|
|
|
|
(set-rear-ptr! deque '()))
|
2020-12-20 13:10:04 +01:00
|
|
|
(else
|
|
|
|
(set-front-ptr! deque (next-node (front-ptr deque)))
|
|
|
|
(set-prev-node! (front-ptr deque) '())
|
|
|
|
deque)))
|
|
|
|
|
|
|
|
(define (rear-delete-deque! deque)
|
|
|
|
(cond ((empty-deque? deque)
|
|
|
|
(error "DELETE! called with an empty deque" deque))
|
2020-12-21 21:16:32 +01:00
|
|
|
((null? (prev-node (rear-ptr deque)))
|
|
|
|
(set-front-ptr! deque '())
|
|
|
|
(set-rear-ptr! deque '()))
|
2020-12-20 13:10:04 +01:00
|
|
|
(else
|
|
|
|
(set-rear-ptr! deque (prev-node (rear-ptr deque)))
|
|
|
|
(set-next-node! (rear-ptr deque) '())
|
|
|
|
deque)))
|
|
|
|
|
|
|
|
|
|
|
|
(define d (make-deque))
|
|
|
|
(front-insert-deque! d 3)
|
|
|
|
(rear-insert-deque! d 4)
|
|
|
|
(front-insert-deque! d 2)
|
|
|
|
(rear-insert-deque! d 5)
|
|
|
|
(front-insert-deque! d 1)
|
|
|
|
(rear-insert-deque! d 6)
|
|
|
|
(display-deque d)
|
|
|
|
|
|
|
|
(front-delete-deque! d)
|
|
|
|
(rear-delete-deque! d)
|
|
|
|
(front-delete-deque! d)
|
|
|
|
(rear-delete-deque! d)
|
2020-12-21 21:16:32 +01:00
|
|
|
(front-delete-deque! d)
|
|
|
|
(rear-delete-deque! d)
|
2020-12-20 13:10:04 +01:00
|
|
|
(display-deque d)
|
2020-12-19 15:22:30 +01:00
|
|
|
|