sicp-ex-3.23



<< Previous exercise (3.22) | Index | Next exercise (3.24) >>


I've implemented the deque required in exercise 3.23 by first defining functions for doubly linked lists. I'm doing this as I'm learning Scheme so sorry for missing the idioms.

 (define (make-dlink value prev next) 
   (cons (cons value prev) next)) 
 (define (value-dlink dlink) (car (car dlink))) 
 (define (next-dlink dlink) (cdr dlink)) 
 (define (prev-dlink dlink) (cdar dlink)) 
 (define (set-value-dlink! dlink v) (set-car! (car dlink) v)) 
 (define (set-next-dlink! dlink ref) (set-cdr! dlink ref)) 
 (define (set-prev-dlink! dlink ref) (set-cdr! (car dlink) ref)) 
  
 (define (push-prev-dlink! dlink value) 
   (and (not (null? (prev-dlink dlink))) 
        (error "PUSH-PREV! called on a middle link" dlink)) 
   (let ((new-pair (make-dlink value null dlink))) 
     (set-prev-dlink! dlink new-pair) 
     new-pair)) 
  
 (define (push-next-dlink! dlink value) 
   (and (not (null? (next-dlink dlink))) 
        (error "PUSH-NEXT! called on a middle link" dlink)) 
   (let ((new-pair (make-dlink value dlink null))) 
     (set-next-dlink! dlink new-pair) 
     new-pair)) 
  
 (define (make-deque) (cons '() '())) 
 (define (front-ptr deque) (car deque)) 
 (define (rear-ptr deque) (cdr deque)) 
 (define (set-front-ptr! deque v) (set-car! deque v)) 
 (define (set-rear-ptr! deque v) (set-cdr! deque v)) 
  
 (define (empty-deque? deque) (null? (front-ptr deque))) 
  
 (define (front-deque deque) 
   (if (empty-deque? deque) 
       (error "FRONT called with an empty deque" deque) 
       (car (front-ptr deque)))) 
  
 (define (rear-deque deque) 
   (if (empty-deque? deque) 
       (error "REAR called with an empty deque" deque) 
       (car (rear-ptr deque)))) 
  
 (define *front* (lambda (x y) x)) 
 (define *rear* (lambda (x y) y)) 
  
 (define (insert-deque! side deque item) 
   (cond ((empty-deque? deque) 
          (let ((new-pair (make-dlink item null null))) 
            (set-front-ptr! deque new-pair) 
            (set-rear-ptr! deque new-pair))) 
         (else 
          (let ((push-ref-dlink! (side push-prev-dlink! push-next-dlink!)) 
                (ptr (side front-ptr rear-ptr)) 
                (set-ptr! (side set-front-ptr! set-rear-ptr!))) 
            (let ((new-pair (push-ref-dlink! (ptr deque) item))) 
              (set-ptr! deque new-pair))))) 
   deque) 
  
 (define (front-insert-deque! deque item) 
   (insert-deque! *front* deque item)) 
  
 (define (rear-insert-deque! deque item) 
   (insert-deque! *rear* deque item)) 
  
 (define (delete-deque! side deque) 
   (and (empty-deque? deque) 
        (error "DELETE! called with an empty deque" deque)) 
   (let ((ptr (side front-ptr rear-ptr)) 
         (set-ptr! (side set-front-ptr! set-rear-ptr!)) 
         (ref-dlink (side next-dlink prev-dlink)) 
         (set-ref-new-dlink! (side set-prev-dlink! set-next-dlink!)) 
         (set-ref-popped-dlink! (side set-next-dlink! set-prev-dlink!))) 
     (let* ((pop (ptr deque)) 
            (new-tip (ref-dlink pop))) 
       (cond ((pair? new-tip) 
              (set-ref-new-dlink! new-tip null) 
              (set-ptr! deque new-tip)) 
             (else 
              (set-front-ptr! deque null) 
              (set-rear-ptr! deque null))) 
       (set-ref-popped-dlink! pop null) 
       (value-dlink pop)))) 
  
 (define (front-delete-deque! deque) 
   (delete-deque! *front* deque)) 
  
 (define (rear-delete-deque! deque) 
   (delete-deque! *rear* deque)) 

gws says: a more compact solution, including a print-deque function to return a list representation of the deque

 (define (make-deque) (cons nil nil)) 
 (define (front-ptr deque) (car deque)) 
 (define (rear-ptr deque) (cdr deque)) 
 (define (empty-deque? deque) (null? (front-ptr deque))) 
 (define (set-front! deque item) (set-car! deque item)) 
 (define (set-rear! deque item) (set-cdr! deque item)) 
  
 (define (get-item deque end) 
   (if (empty-deque? deque) 
     (error "Trying to retrieve item from empty deque" deque) 
     (caar (end deque)))) 
  
 (define (insert-deque! deque item end) 
   (let ((new-pair (cons (cons item nil) nil))) 
     (cond ((empty-deque? deque) 
            (set-front! deque new-pair) 
            (set-rear! deque new-pair)) 
           ((eq? end 'front) 
            (set-cdr! new-pair (front-ptr deque)) 
            (set-cdr! (car (front-ptr deque)) new-pair) 
            (set-front! deque new-pair)) 
           (else (set-cdr! (rear-ptr deque) new-pair) 
                 (set-cdr! (car new-pair) (rear-ptr deque)) 
                 (set-rear! deque new-pair))))) 
  
 (define (front-delete-deque deque) 
   (cond ((empty-deque? deque) (error "Cannot delete from empty deque" deque)) 
         (else (set-front! deque (cdr (front-ptr deque))) 
               (or (empty-deque? deque) (set-cdr! (car (front-ptr deque)) nil))))) 
  
 (define (rear-delete-deque deque) 
   (cond ((empty-deque? deque) (error "Cannot delete from empty deque" deque)) 
         (else (set-rear! deque (cdar (rear-ptr deque))) 
               (if (null? (rear-ptr deque)) (set-front! deque nil) 
                 (set-cdr! (rear-ptr deque) nil))))) 
  
 (define (front-insert-deque! deque item) (insert-deque! deque item 'front)) 
 (define (rear-insert-deque! deque item) (insert-deque! deque item 'rear)) 
 (define (front-deque deque) (get-item deque front-ptr)) 
 (define (rear-deque deque) (get-item deque rear-ptr)) 
  
 (define (print-deque d) 
   (define (iter res _d) 
     (if (or (null? _d) (empty-deque? _d)) res 
       (iter (append res (list (caaar _d))) (cons (cdar _d) (cdr d))))) 
   (iter nil d)) 

danhuynh

Kinda the same as above but using internal variables instead of pair

  
 ;;; We gonna make a two way structure like this diagram 
 ;;;                 +-------------------+ 
 ;;; +---------------|------+            | 
 ;;; +->[[a|/] | -]--+->[[b|'] | -]->[[c|'] |/] 
 ;;; 
 ;;; Which will display this in the repl of guile scheme 
 ;;; ((a) (b . #-2#) (c . #-2#)) 
  
 (define (make-deque) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
     (define (dispatch m) 
       (cond ((equal? m 'empty-deque?) 
              (null? front-ptr)) 
             ((equal? m 'rear-ptr) 
              rear-ptr) 
             ((equal? m 'front-ptr) 
              front-ptr) 
             ((equal? m 'set-front-ptr!) 
              (lambda (item) (set! front-ptr item))) 
             ((equal? m 'set-rear-ptr!) 
              (lambda (item) (set! rear-ptr item))))) 
     dispatch)) 
  
 (define (empty-deque? deque) 
   (deque 'empty-deque?)) 
 (define (front-ptr deque) 
   (deque 'front-ptr)) 
 (define (rear-ptr deque) 
   (deque 'rear-ptr)) 
 (define (front-deque deque) 
   (if (empty-deque? deque) 
       (error "FRONT called with an empty deque" deque) 
       (caar (front-ptr deque)))) 
 (define (rear-deque deque) 
   (if (empty-deque? deque) 
       (error "REAR called with an empty deque" deque) 
       (caar (rear-ptr deque)))) 
 (define (set-front-ptr! deque item) 
   ((deque 'set-front-ptr!) item)) 
 (define (set-rear-ptr! deque item) 
   ((deque 'set-rear-ptr!) item)) 
  
 (define (front-insert-deque! deque item) 
   (let ((newlist (cons (cons item '()) '()))) 
     (if (empty-deque? deque) 
         (begin 
           (set-front-ptr! deque newlist) 
           (set-rear-ptr! deque newlist) 
           deque) 
         (begin 
           (set-cdr! (car (front-ptr deque)) newlist) 
           (set-cdr! newlist (front-ptr deque)) 
           (set-front-ptr! deque newlist) 
           deque)))) 
  
 (define (rear-insert-deque! deque item) 
   (let ((newlist (cons (cons item '()) '()))) 
     (if (empty-deque? deque) 
         (begin 
           (set-front-ptr! deque newlist) 
           (set-rear-ptr! deque newlist) 
           deque) 
         (begin 
           (set-cdr! (car newlist) (rear-ptr deque)) 
           (set-cdr! (rear-ptr deque) newlist) 
           (set-rear-ptr! deque newlist) 
           deque)))) 
  
 (define (front-delete-deque! deque) 
   (cond ((empty-deque? deque) 
          (error "DELETE! called with an empty deque" deque)) 
         ((null? (cdar (rear-ptr deque))) 
          (set-front-ptr! deque '())) 
         (else 
          (set-front-ptr! deque (cdr (front-ptr deque))) 
          (set-cdr! (car (front-ptr deque)) '()) 
          deque))) 
  
 (define (rear-delete-deque! deque) 
   (cond ((empty-deque? deque) 
          (error "DELETE! called with an empty deque" deque)) 
         ((null? (cdar (rear-ptr deque))) 
          (set-front-ptr! deque '())) 
         (else 
          (set-rear-ptr! deque (cdar (rear-ptr deque))) 
          (set-cdr! (rear-ptr deque) '())))) 
  
 (define (print-deque deque) 
   (display (map car 
                 (front-ptr deque))) (newline)) 

Use One-layer list instead of Two-layer list above and use inner define style

 (define (make-deque) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
     ;;;sub process 
     (define (front-insert-deque! item) 
       (let ((new-pair (list item '() '()))) 
         (cond ((null? front-ptr) 
                (set! front-ptr new-pair) 
                (set! rear-ptr new-pair)) 
               (else 
                (set-cdr! (cdr new-pair) front-ptr) 
                (set-car! (cdr front-ptr) new-pair) 
                (set! front-ptr new-pair))) 
         front-ptr)) 
     (define (rear-insert-deque! item) 
       (let ((new-pair (list item '() '()))) 
         (cond ((null? front-ptr) 
                (set! front-ptr new-pair) 
                (set! rear-ptr new-pair)) 
               (else 
                (set-car! (cdr new-pair) rear-ptr) 
                (set-cdr! (cdr rear-ptr) new-pair) 
                (set! rear-ptr new-pair))) 
         front-ptr)) 
     (define (front-delete-deque!) 
       (set! front-ptr (cddr front-ptr)) 
       (set-car! (cdr front-ptr) '()) 
       front-ptr) 
     (define (rear-delete-deque!) 
       (set! rear-ptr (cadr rear-ptr)) 
       (set-cdr! (cdr rear-ptr) '()) 
       front-ptr) 
     (define (print) 
       (define (iter x result) 
                (if (null? (cddr x)) 
                    (append result (cons (car x) '())) 
                    (iter (cddr x) (append result (cons (car x) '()))))) 
       (iter front-ptr '())) 
      
     (define (dispatch m) 
       (cond ((eq? m 'front-ptr) front-ptr) 
             ((eq? m 'rear-ptr) rear-ptr) 
             ((eq? m 'print) print) 
             ((eq? m 'empty-queue?) (null? front-ptr)) 
             ((eq? m 'front-delete-deque!) front-delete-deque!) 
             ((eq? m 'rear-delete-deque!) rear-delete-deque!) 
             ((eq? m 'rear-insert-deque!) rear-insert-deque!) 
             ((eq? m 'front-insert-deque!) front-insert-deque!) 
             (else 
              (display "Bad operate")))) 
     dispatch)) 
 (define mq (make-deque)) 
 ((mq 'rear-insert-deque!) 'a) 
 ((mq 'rear-insert-deque!) 'b) 
 ((mq 'rear-insert-deque!) 'c) 
 ((mq 'front-insert-deque!) 'd) 
 ((mq 'front-insert-deque!) 'e) 
 ((mq 'front-insert-deque!) 'f) 
 ((mq 'front-delete-deque!)) 
 ((mq 'rear-delete-deque!)) 
 ((mq 'print)) 


GP

Since we have learnt in Chap 2. about data abstraction and abstraction layers, it makes more sense here to build one more abstraction layer by adding properly designed constructors and selectors. The solution will be more modularized and extendable. The code is also a bit more readable in my opinion.

 ; using local variables and message passing instead of defining function under global environment 
  
 (define (make-deque) 
   (let ((front-ptr '()) 
         (rear-ptr '())) 
  
     ; one more abstraction barrier allows flexible and extendable implementation for both lower and higher level methods 
     ; one example here is modifing lower level implementation of node structure dose not  the methods for deque 
     ; also, higher level modification (modifying deque methods) will not influence lower level implementation 
  
     ; lower level constructor and selectors 
     ; each has two different implementations. (higher level methods do not need to be changed)  
     (define (make-node item) 
       (cons (cons item '()) '())) 
     (define (make-node1 item) 
       (cons item (cons '() '()))) 
  
     (define (node-item node) 
       (caar node)) 
     (define (node-item1 node) 
       (car node)) 
  
     (define (next-node node) 
       (cdr node)) 
     (define (next-node1 node) 
       (cddr node)) 
  
     (define (prev-node node) 
       (cdar node)) 
     (define (prev-node1 node) 
       (cadr node)) 
     (define (set-prev-node! node prevnode) 
       (set-cdr! (car node) prevnode)) 
     (define (set-prev-node!1 node prevnode) 
       (set-car! (cdr node) prevnode)) 
     (define (set-next-node! node nextnode) 
       (set-cdr! node nextnode)) 
     (define (set-next-node!1 node nextnode) 
       (set-cdr! (cdr node) nextnode)) 
  
     (define (set-front-ptr! item) 
       (set! front-ptr item)) 
     (define (set-rear-ptr! item) 
       (set! rear-ptr item)) 
  
  
     ; higher level methods for deque 
     ; constructors and selectors 
     (define (empty-deque?) (null? front-ptr)) 
      
     (define (front-deque) 
       (if (empty-deque?) 
           (error "FRONT called with an empty deque") 
           (node-item front-ptr))) 
  
     (define (front-insert-deque! item) 
       (let ((new-node (make-node item))) 
         (cond ((empty-deque?) 
                (set-front-ptr! new-node) 
                (set-rear-ptr! new-node)) 
               (else 
                (set-prev-node! front-ptr new-node) 
                (set-next-node! new-node front-ptr) 
                (set-front-ptr! new-node))))) 
  
     ; methods to modify deques 
     (define (rear-insert-deque! item) 
       (let ((new-node (make-node item))) 
         (cond ((empty-deque?) 
                (set-front-ptr! new-node) 
                (set-rear-ptr! new-node)) 
               (else 
                (set-prev-node! new-node rear-ptr) 
                (set-next-node! rear-ptr new-node) 
                (set-rear-ptr! new-node))))) 
  
     (define (front-delete-deque!) 
       (cond ((empty-deque?) 
              (error "DELETE! called with an empty deque")) 
             (else 
              (set-front-ptr! (next-node front-ptr)) 
              (if (null? front-ptr) 
                  (set-rear-ptr! '()) 
                  (set-prev-node! front-ptr '()))))) 
  
     (define (rear-delete-deque!) 
       (cond ((empty-deque?) 
              (error "DELETE! called with an empty deque")) 
             (else 
              (set-rear-ptr! (prev-node rear-ptr)) 
              (if (null? rear-ptr) 
                  (set-front-ptr! '()) 
                  (set-next-node! rear-ptr '()))))) 
  
     (define (print-deque) 
       (define (print-node node) 
         (cond ((null? node) nil) 
               (else (cons (node-item node) (print-node (next-node node)))))) 
       (display (print-node front-ptr)) 
       (newline)) 
  
     (define (dispatch m) 
       (cond ((eq? m 'front-deque) front-deque) 
             ((eq? m 'empty-deque?) empty-deque?) 
             ((eq? m 'front-insert-deque!) front-insert-deque!) 
             ((eq? m 'rear-insert-deque!) rear-insert-deque!) 
             ((eq? m 'front-delete-deque!) front-delete-deque!) 
             ((eq? m 'rear-delete-deque!) rear-delete-deque!) 
             ((eq? m 'print-deque) print-deque))) 
     dispatch)) 
  
 ;define global methods with message passing 
 (define (front-deque deque) ((deque 'front-deque))) 
 (define (empty-deque? deque) ((deque 'empty-deque?))) 
 (define (front-insert-deque! deque item) ((deque 'front-insert-deque!) item)) 
 (define (rear-insert-deque! deque item) ((deque 'rear-insert-deque!) item)) 
 (define (front-delete-deque! deque) ((deque 'front-delete-deque!))) 
 (define (rear-delete-deque! deque) ((deque 'rear-delete-deque!))) 
 (define (print-deque deque) ((deque 'print-deque))) 
  
 ;; ---- TESTING CODE ----  
 ;test deque constructor and selectors 
 (define d (make-deque)) 
 (empty-deque? d) 
 (print-deque d) 
  
 ; testing front insert  
 (newline) 
 (display "---- testing front insert ----") 
 (newline) 
 (front-insert-deque! d 'a) 
 (print-deque d) 
 (front-insert-deque! d 'b) 
 (print-deque d) 
 (front-insert-deque! d 'c) 
 (print-deque d) 
  
 ; testing front delete 
 (newline) 
 (display "---- testing front delete ----") 
 (newline) 
 (front-delete-deque! d) 
 (print-deque d) 
 (front-delete-deque! d) 
 (print-deque d) 
 (front-delete-deque! d) 
 (print-deque d) 
  
 ; testing rear insert  
 (newline) 
 (display "---- testing rear insert ----") 
 (newline) 
 (rear-insert-deque! d 'a) 
 (print-deque d) 
 (rear-insert-deque! d 'b) 
 (print-deque d) 
 (rear-insert-deque! d 'c) 
 (print-deque d) 
  
 ; testing rear delete 
 (newline) 
 (display "---- testing rear delete ----") 
 (newline) 
 (rear-delete-deque! d) 
 (print-deque d) 
 (rear-delete-deque! d) 
 (print-deque d) 
 (rear-delete-deque! d) 
 (print-deque d) 
  
 ; testing front-insert and rear delete 
 (newline) 
 (display "---- testing front-insert and rear delete ----") 
 (newline) 
 (front-insert-deque! d 'a) 
 (print-deque d) 
 (rear-delete-deque! d) 
 (print-deque d) 

<< Previous exercise (3.22) | Index | Next exercise (3.24) >>