1 665c255d 2023-08-04 jrmu ;; Exercise 3.23.  A deque (``double-ended queue'') is a sequence in which items can be inserted and deleted at either the front or the rear. Operations on deques are the constructor make-deque, the predicate empty-deque?, selectors front-deque and rear-deque, and mutators front-insert-deque!, rear-insert-deque!, front-delete-deque!, and rear-delete-deque!. Show how to represent deques using pairs, and give implementations of the operations.23 All operations should be accomplished in (1) steps. 
  2 665c255d 2023-08-04 jrmu 
  3 665c255d 2023-08-04 jrmu (define (test-case actual expected)
  4 665c255d 2023-08-04 jrmu   (newline)
  5 665c255d 2023-08-04 jrmu   (display "Actual:   ")
  6 665c255d 2023-08-04 jrmu   (display actual)
  7 665c255d 2023-08-04 jrmu   (newline)
  8 665c255d 2023-08-04 jrmu   (display "Expected: ")
  9 665c255d 2023-08-04 jrmu   (display expected)
 10 665c255d 2023-08-04 jrmu   (newline))
 11 665c255d 2023-08-04 jrmu 
 12 665c255d 2023-08-04 jrmu (define (make-link val prev next)
 13 665c255d 2023-08-04 jrmu   (cons (cons val prev) next))
 14 665c255d 2023-08-04 jrmu (define (link-value l)
 15 665c255d 2023-08-04 jrmu   (caar l))
 16 665c255d 2023-08-04 jrmu (define (link-prev l)
 17 665c255d 2023-08-04 jrmu   (cdar l))
 18 665c255d 2023-08-04 jrmu (define (link-next l)
 19 665c255d 2023-08-04 jrmu   (cdr l))
 20 665c255d 2023-08-04 jrmu (define (set-link-prev! link prev)
 21 665c255d 2023-08-04 jrmu   (set-cdr! (car link) prev))
 22 665c255d 2023-08-04 jrmu (define (set-link-next! link next)
 23 665c255d 2023-08-04 jrmu   (set-cdr! link next))
 24 665c255d 2023-08-04 jrmu (define (link->list l)
 25 665c255d 2023-08-04 jrmu   (map car l))
 26 665c255d 2023-08-04 jrmu 
 27 665c255d 2023-08-04 jrmu (define (make-deque)
 28 665c255d 2023-08-04 jrmu   (cons '() '()))
 29 665c255d 2023-08-04 jrmu (define (empty-deque? deque)
 30 665c255d 2023-08-04 jrmu   (null? (car deque)))
 31 665c255d 2023-08-04 jrmu (define (front-deque deque)
 32 665c255d 2023-08-04 jrmu   (link-value (car deque)))
 33 665c255d 2023-08-04 jrmu (define (rear-deque deque)
 34 665c255d 2023-08-04 jrmu   (link-value (cdr deque)))
 35 665c255d 2023-08-04 jrmu (define (front-insert-deque! deque item)
 36 665c255d 2023-08-04 jrmu   (let ((new-link (make-link item '() (car deque))))
 37 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
 38 665c255d 2023-08-04 jrmu 	   (set-car! deque new-link)
 39 665c255d 2023-08-04 jrmu 	   (set-cdr! deque new-link))
 40 665c255d 2023-08-04 jrmu 	  (else 
 41 665c255d 2023-08-04 jrmu 	   (set-link-prev! (car deque) new-link)
 42 665c255d 2023-08-04 jrmu 	   (set-car! deque new-link))))
 43 665c255d 2023-08-04 jrmu   deque)
 44 665c255d 2023-08-04 jrmu (define (rear-insert-deque! deque item)
 45 665c255d 2023-08-04 jrmu   (let ((new-link (make-link item (cdr deque) '())))
 46 665c255d 2023-08-04 jrmu     (cond ((empty-deque? deque)
 47 665c255d 2023-08-04 jrmu 	   (set-car! deque new-link)
 48 665c255d 2023-08-04 jrmu 	   (set-cdr! deque new-link))
 49 665c255d 2023-08-04 jrmu 	  (else
 50 665c255d 2023-08-04 jrmu 	   (set-link-next! (cdr deque) new-link)
 51 665c255d 2023-08-04 jrmu 	   (set-cdr! deque new-link))))
 52 665c255d 2023-08-04 jrmu   deque)
 53 665c255d 2023-08-04 jrmu 
 54 665c255d 2023-08-04 jrmu (define (front-delete-deque! deque) 
 55 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
 56 665c255d 2023-08-04 jrmu       (error "FRONT-DELETE-DEQUE! on empty deque"))
 57 665c255d 2023-08-04 jrmu   (set-car! deque (link-next (car deque)))
 58 665c255d 2023-08-04 jrmu   (if (null? (car deque))
 59 665c255d 2023-08-04 jrmu       (set-cdr! deque '())
 60 665c255d 2023-08-04 jrmu       (set-link-prev! (car deque) '())))
 61 665c255d 2023-08-04 jrmu (define (rear-delete-deque! deque)
 62 665c255d 2023-08-04 jrmu   (if (empty-deque? deque)
 63 665c255d 2023-08-04 jrmu       (error "REAR-DELETE-DEQUE! on empty deque"))
 64 665c255d 2023-08-04 jrmu   (set-cdr! deque (link-prev (cdr deque)))
 65 665c255d 2023-08-04 jrmu   (if (null? (cdr deque))
 66 665c255d 2023-08-04 jrmu       (set-car! deque '())
 67 665c255d 2023-08-04 jrmu       (set-link-next! (cdr deque) '())))
 68 665c255d 2023-08-04 jrmu (define (deque->list deque)
 69 665c255d 2023-08-04 jrmu   (link->list (car deque)))
 70 665c255d 2023-08-04 jrmu 
 71 665c255d 2023-08-04 jrmu (define (print-deque deque)
 72 665c255d 2023-08-04 jrmu   (newline)
 73 665c255d 2023-08-04 jrmu   (newline)
 74 665c255d 2023-08-04 jrmu   (display (deque->list deque))
 75 665c255d 2023-08-04 jrmu   (newline)
 76 665c255d 2023-08-04 jrmu   (deque->list deque))
 77 665c255d 2023-08-04 jrmu 
 78 665c255d 2023-08-04 jrmu (define la (make-link 'a '() '()))
 79 665c255d 2023-08-04 jrmu (define lb (make-link 'b '() '()))
 80 665c255d 2023-08-04 jrmu (define lc (make-link 'c '() '()))
 81 665c255d 2023-08-04 jrmu (define ld (make-link 'd '() '()))
 82 665c255d 2023-08-04 jrmu (set-link-next! la lb)
 83 665c255d 2023-08-04 jrmu (set-link-prev! lb la)
 84 665c255d 2023-08-04 jrmu (set-link-next! lb lc)
 85 665c255d 2023-08-04 jrmu (set-link-prev! lc lb)
 86 665c255d 2023-08-04 jrmu (set-link-next! lc ld)
 87 665c255d 2023-08-04 jrmu (set-link-prev! ld lc)
 88 665c255d 2023-08-04 jrmu (test-case (link->list la) '(a b c d))
 89 665c255d 2023-08-04 jrmu 
 90 665c255d 2023-08-04 jrmu (define dq (make-deque))
 91 665c255d 2023-08-04 jrmu (front-insert-deque! dq 'a)
 92 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(a))
 93 665c255d 2023-08-04 jrmu (front-insert-deque! dq 'b)
 94 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(b a))
 95 665c255d 2023-08-04 jrmu (rear-insert-deque! dq 'c)
 96 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(b a c))
 97 665c255d 2023-08-04 jrmu (rear-insert-deque! dq 'd)
 98 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(b a c d))
 99 665c255d 2023-08-04 jrmu (front-delete-deque! dq)
100 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(a c d))
101 665c255d 2023-08-04 jrmu (rear-delete-deque! dq)
102 665c255d 2023-08-04 jrmu (test-case (print-deque dq) '(a c))
103 665c255d 2023-08-04 jrmu (test-case (front-deque dq) 'a)
104 665c255d 2023-08-04 jrmu (test-case (rear-deque dq) 'c)