adrianwong programmer · retired coal miner

SICP section 3.3 - modelling with mutable data (incomplete)

This is the second section whose content I haven’t been too enthused about (the first being section 2.5). This, rather coincidentally :smirk:, is also the second section whose exercises I’ve left incomplete (the first being section 2.5 :wink:).

…I need to be more tenacious :expressionless:.

That aside, yay jemoji :raised_hands:! Ah, the little things in life…

Selected exercises

Exercise 3.12

Given:

(define (last-pair x)
  (if (null? (cdr x)) x (last-pair (cdr x))))

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)

…and a sequence of interactions, we are asked to determine the values of (cdr x):

(define x (list 'a 'b))
(define y (list 'c 'd))
(define z (append x y))

z       ; '(a b c d)
(cdr x) ; '(b)

(define w (append! x y))

w       ; '(a b c d)
(cdr x) ; '(b c d)

Exercise 3.13

By calling:

(define z (make-cycle (list 'a 'b 'c)))

…a circular list is created (the make-cycle procedure name is a dead giveaway). Instead of pointing to '(), the cdr of the last-pair of '(a b c) now points to the start of the list.

Computing (last-pair z) results in the procedure recursing infinitely.

Exercise 3.14

Given a mystery procedure, we have to determine what it does:

(define (mystery x)
  (define (loop x y)
    (if (null? x) y
        (let ((temp (cdr x)))
          (set-cdr! x y)
          (loop temp x))))
  (loop x '()))

(define v '(a b c d))
(define w (mystery v))

It’s obvious that mystery mysteriously and magically reverses a list.

The final values of v and w are:

v ; '(a)
w ; '(d c b a)

Exercise 3.16

Given Ben Bitdiddle’s incorrect procedure:

(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
         (count-pairs (cdr x))
         1)))

…we rub some salt in Ben’s wounds by providing list structures made up of exactly three pairs where Ben’s procedure returns 3, 4, 7, and never returns:

(define x '(1 2 3))
(count-pairs x) ; 3

(set-car! (cdr x) (cddr x))
(count-pairs x) ; 4

(set-car! x (cdr x))
(count-pairs x) ; 7

(set-cdr! (cddr x) x)
(count-pairs x) ; Never returns

Note: we’ll use these same list structures to test the solutions for exercises 3.17 through to 3.19.

Exercise 3.17

Fixing Ben’s procedure using the recommended approach of maintaining an auxiliary data structure visited that keeps tracks of procedures that have been counted:

(define (count-pairs x)
  (let ((visited '()))
    (define (count-pairs-internal x)
      (if (or (not (pair? x)) (memq x visited))
          0
          (begin
            (set! visited (cons x visited))
            (+ (count-pairs-internal (car x))
               (count-pairs-internal (cdr x))
               1))))
    (count-pairs-internal x)))

Tests:

(define x '(1 2 3))
(count-pairs x) ; 3

(set-car! (cdr x) (cddr x))
(count-pairs x) ; 3

(set-car! x (cdr x))
(count-pairs x) ; 3

(set-cdr! (cddr x) x)
(count-pairs x) ; 3

Exercise 3.18

Procedure to determine if a list contains a cycle:

(define (has-cycle? x)
  (let ((visited '()))
    (define (has-cycle-iter x)
      (cond ((null? (cdr x)) #f)
            ((memq (cadr x) visited) #t)
            (else
             (set! visited (cons (car x) visited))
             (has-cycle-iter (cdr x)))))
    (has-cycle-iter x)))

Tests:

(define x '(1 2 3))
(has-cycle? x) ; #f

(set-car! (cdr x) (cddr x))
(has-cycle? x) ; #f

(set-car! x (cdr x))
(has-cycle? x) ; #f

(set-cdr! (cddr x) x)
(has-cycle? x) ; #t

Extra tests using make-cycle from exercise 3.13:

(define z (make-cycle '(a b c)))
(has-cycle? z)        ; #t
(has-cycle? '(a b c)) ; #f

Exercise 3.19

This “very clever idea” is the well-known tortoise and hare algorithm that some interviewer somewhere is going to ask some poor soul to code up on some whiteboard:

(define (has-cycle? x)
  (define (has-cycle-iter x y)
    (cond ((null? (cdr x)) #f)
          ((null? (cdr y)) #f)
          ((eq? x y) #t)
          (else (has-cycle-iter (cdr x) (cddr y)))))
  (has-cycle-iter (cdr x) (cddr x)))

Exercise 3.21

Eva Lu Ator is right: the standard Lisp printer is printing the underlying representation “as-is”. We’ll have to define our own print procedure if we want to see the queue printed “correctly”.

Explaining why Ben’s examples produce the printed results that they do:

(define q1 (make-queue))

(insert-queue! q1 'a)
; `front-ptr` points to the only pair '(a)
; `rear-ptr` points to the only pair '(a)

(insert-queue! q1 'b)
; `front-ptr` points to the start of the queue '(a b)
; `rear-ptr` points to the last pair in the queue '(b)

(delete-queue! q1)
; `front-ptr` points to the `cdr` of the queue '(a b), i.e. '(b)
; `rear-ptr` points to the last pair in the queue '(b)

(delete-queue! q1)
; `front-ptr` points to the `cddr` of the queue '(a b), i.e. '()
; `rear-ptr` points to the last pair in the queue '(b)

Defining the print-queue procedure is simple, we just display the car of the queue:

(define (print-queue queue)
  (display (front-ptr queue))
  (newline))

Exercise 3.22

(define (make-queue)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (queue)
      (cons front-ptr rear-ptr))
    (define (set-front-ptr! item)
      (set! front-ptr item))
    (define (set-rear-ptr! item)
      (set! rear-ptr item))
    (define (empty-queue?)
      (null? front-ptr))
    (define (front-queue)
      (if (empty-queue?)
          (error "FRONT called with an empty queue" (queue))
          (car front-ptr)))
    (define (insert-queue! item)
      (let ((new-pair (cons item '())))
        (cond ((empty-queue?)
               (set-front-ptr! new-pair)
               (set-rear-ptr! new-pair)
               (queue))
              (else
               (set-cdr! rear-ptr new-pair)
               (set-rear-ptr! new-pair)
               (queue)))))
    (define (delete-queue!)
      (cond ((empty-queue?)
             (error "DELETE! called with an empty queue" (queue)))
            (else (set-front-ptr! (cdr front-ptr))
                  (queue))))
    (define (print-queue)
      (display front-ptr)
      (newline))
    (define (dispatch m)
      (cond ((eq? m 'front-queue) front-queue)
            ((eq? m 'insert-queue!) insert-queue!)
            ((eq? m 'delete-queue!) delete-queue!)
            ((eq? m 'print-queue) print-queue)
            (else (error "Unknown request: MAKE-QUEUE"
                         m))))
    dispatch))

Exercise 3.23

I must admit - this exercise had me stumped. I’ve implemented many a singly and doubly linked list in C, but I just couldn’t quite grasp how to do the same in Scheme. It’s probably because I was being thick.

After much staring at other people’s solutions, I’ve adopted the approach of having each pair hold a backward-pointer to the previous pair in the queue.

Heavily annotated code in an effort to un-stump myself:

(define (make-deque)
  (let ((front-ptr '())
        (rear-ptr '()))
    (define (deque)
      (cons 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 deque" (deque))
          (caar front-ptr)))
    (define (rear-deque)
      (if (empty-deque?)
          (error "REAR called with an empty deque" (deque))
          (caar rear-ptr)))
    (define (front-insert-deque! item)
      (let ((new-pair (cons (cons item '()) '())))
        (cond ((empty-deque?)
               (set-front-ptr! new-pair)
               (set-rear-ptr! new-pair)
               (deque))
              (else
               ; Set the backward-pointer of the first pair
               ; in the queue to the new pair
               (set-cdr! (car front-ptr) new-pair)
               ; Add the new pair to the front of the queue
               ; by appending the front pointer to the new pair
               (set-cdr! new-pair front-ptr)
               ; Set the front pointer to the new pair, as it
               ; is now the first pair in the queue
               (set-front-ptr! new-pair)
               (deque)))))
    (define (rear-insert-deque! item)
      (let ((new-pair (cons (cons item '()) '())))
        (cond ((empty-deque?)
               (set-front-ptr! new-pair)
               (set-rear-ptr! new-pair)
               (deque))
              (else
               ; Set the backward-pointer on the new pair to the
               ; current last pair in the queue
               (set-cdr! (car new-pair) rear-ptr)
               ; Add the new pair to the rear of the queue
               ; via the rear pointer
               (set-cdr! rear-ptr new-pair)
               ; Set the rear pointer to the new pair, as it
               ; is now the last pair in the queue
               (set-rear-ptr! new-pair)
               (deque)))))
    (define (front-delete-deque!)
      (cond ((empty-deque?)
             (error "FRONT-DELETE! called with an empty deque" (deque)))
            ((null? (cdar rear-ptr))
             (set-front-ptr! '()))
            (else
             ; Move the front pointer "forward" one pair
             (set-front-ptr! (cdr front-ptr))
             ; Set the backward-pointer of the new front pair to '()
             (set-cdr! (car front-ptr) '())
             (deque))))
    (define (rear-delete-deque!)
      (cond ((empty-deque?)
             (error "REAR-DELETE! called with an empty deque" (deque)))
            ((null? (cdar rear-ptr))
             (set-front-ptr! '()))
            (else
             ; Move the rear pointer "backward" one pair
             (set-rear-ptr! (cdar rear-ptr))
             ; Set the forward-pointer of the new rear pair to '()
             (set-cdr! rear-ptr '())
             (deque))))
    (define (print-deque)
      ; The `car` of a pair holds the data,
      ; the `cdr` holds the backward-pointer
      (display (map car front-ptr))
      (newline))
    (define (dispatch m)
      (cond ((eq? m 'front-deque) front-deque)
            ((eq? m 'rear-deque) rear-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)
            (else (error "Unknown request: MAKE-DEQUE"
                         m))))
    dispatch))

Tests:

(define d1 (make-deque))

((d1 'front-insert-deque!) 'b)
((d1 'print-deque)) ; '(b)
((d1 'front-deque)) ; 'b
((d1 'rear-deque))  ; 'b

((d1 'rear-insert-deque!) 'c)
((d1 'print-deque)) ; '(b c)
((d1 'front-deque)) ; 'b
((d1 'rear-deque))  ; 'c

((d1 'front-insert-deque!) 'a)
((d1 'print-deque)) ; '(a b c)
((d1 'front-deque)) ; 'a
((d1 'rear-deque))  ; 'c

((d1 'rear-delete-deque!))
((d1 'print-deque)) ; '(a b)
((d1 'front-deque)) ; 'a
((d1 'rear-deque))  ; 'b

((d1 'front-delete-deque!))
((d1 'print-deque)) ; '(b)
((d1 'front-deque)) ; 'b
((d1 'rear-deque))  ; 'b

((d1 'rear-delete-deque!))
((d1 'print-deque)) ; '()