CS 61A -- Week 10 Solutions LAB ASSIGNMENT: 3.12 append vs. append! exp1 is (b); exp2 is (b c d). Append (without the !) makes copies of the two pairs that are part of the list x. (You can tell because it uses cons, which is the constructor function that generates a brand new pair.) Append! does not invoke cons; it mutates the existing pairs to combine the two argument lists. 2. Set! vs. set-cdr! There are two ways to think about this, and you should understand both of them: The syntactic explanation -- SET! is a special form; its first argument must be a symbol, not a compound expression. So anything of the form (set! (...) ...) must be an error. The semantic explanation -- SET! and SET-CDR! are about two completely different purposes. SET! is about the bindings of variables in an environment. SET-CDR! is about pointers within pairs. SET! has nothing to do with pairs; SET-CDR! has nothing to do with variables. There is no situation in which they are interchangeable. (Note: The book says, correctly, that the two are *equivalent* in the sense that you can use one to implement the other. But what that means is that, for example, if we didn't have pairs in our language we could use the oop techniques we've learned, including local state variables bound in an environment, to simulate pairs. Conversely, we'll see in Chapter 4 that we can write a Scheme interpreter, including environments as an abstract data type, building them out of pairs. But given that we are using the regular Scheme's built-in pairs and built-in environments, those have nothing to do with each other.) 3a. Fill in the blanks. > (define list1 (list (list 'a) 'b)) list1 > (define list2 (list (list 'x) 'y)) list2 > (set-cdr! ____________ ______________) okay > (set-cdr! ____________ ______________) okay > list1 ((a x b) b) > list2 ((x b) y) The key point here is that if we're only allowed these two SET-CDR!s then we'd better modify list2 first, because the new value for list1 uses the sublist (x b) that we'll create for list2. So it's (set-cdr! (car list2) (cdr list1)) (set-cdr! (car list1) (car list2)) 3b. Now do (set-car! (cdr list1) (cadr list2)). Everything that used to be "b" is now "y" instead: > list1 ((a x y) y) > list2 ((x y) y) The reason is that there was only one appearance of the symbol B in the diagram, namely as the cadr of list1; every appearance of B in the printed representation of list1 or list2 came from pointers to the pair (cdr list1). The SET-CAR! only makes one change to one pair, but three different things point (directly or indirectly) to it. 3.13 make-cycle The diagram is +----------------+ | | V | ---> XX--->XX--->XX---+ | | | V V V a b c (last-pair z) will never return, because there is always a non-empty cdr to look at next. 3.14 Mystery procedure. This procedure is REVERSE!, that is to say, it reverses the list by mutation. After (define v (list 'a 'b 'c 'd)) (define w (mystery v)) the value of w is the list (d c b a); the value of v is the list (a) because v is still bound to the pair whose car is a. (The procedure does not change the cars of any pairs.) 5a. We want Scheme-2 to accept both the ordinary form (define x 3) and the procedure-abbreviation form (define (square x) (* x x)) The latter should be treated as if the user had typed (define square (lambda (x) (* x x))) The hint says we can use data abstraction to achieve this. Here is the existing code that handles DEFINE: (define (eval-2 exp env) (cond ... ((define-exp? exp) (put (cadr exp) (eval-2 (caddr exp) env) env) 'okay) ...)) We're going to use selectors for the pieces of the DEFINE expression: (define (eval-2 exp env) (cond ... ((define-exp? exp) (put (DEFINE-VARIABLE exp) (eval-2 (DEFINE-VALUE exp) env) env) 'okay) ...)) To get the original behavior we would define the selectors this way: (define define-variable cadr) (define define-value caddr) But instead we'll check to see if the cadr of the expression is a symbol (so we use the ordinary notation) or a list (abbreviating a procedure definition): (define (define-variable exp) (if (pair? (cadr exp)) (caadr exp) ;(define (XXXX params) body) (cadr exp))) (define (define-value exp) (if (pair? (cadr exp)) (cons 'lambda (cons (cdadr exp) ;params (cddr exp))) ;body (caddr exp))) Writing selectors like this is the sort of situation in which the compositions like CAADR are helpful. That particular one is (car (cadr exp)), which is the first element of the second element of the expression. (You should recognize CADR, CADDR, and CADDDR as selectors for the second, third, and fourth elements of a list.) The second element of the expression is a list such as (SQUARE X), so the car of that list is the variable name. Since DEFINE-VALUE is supposed to return an expression, we have to construct a LAMBDA expression, making explicit what this notation abbreviates. 5c. In a procedure call, parameters are processed from left to right, and PUT adds each parameter to the front of the environment. So they end up in reverse order. Similarly, top-level DEFINEs add things to the global environment in reverse order. So the sequence of expressions should be Scheme-2: (define b 2) Scheme-2: (define a 1) Scheme-2: ((lambda (c b) 'foo) 4 3) It doesn't matter what's in the body of the procedure, since we're interested in the environments rather than in the values returned. HOMEWORK: 3.16 incorrect count-pairs This procedure would work fine for any list structure that can be expressed as (quote ). It fails when there are two pointers to the same pair. (define a '(1 2 3)) (count-pairs a) --> 3 (define b (list 1 2 3)) (set-car! (cdr b) (cddr b)) (count-pairs b) --> 4 (define x (list 1)) (define y (cons x x)) (define c (cons y y)) (count-pairs c) --> 7 (define d (make-cycle (list 1 2 3))) (count-pairs d) --> infinite loop Note from example c that it's not necessary to use mutators to create a list structure for which this count-pairs fails, but it is necessary to have a name for a substructure so that you can make two pointers to it. The name needn't be global, though; I could have said this: (define c (let ((x (list 1))) (let ((y (cons x x))) (cons y y) ))) 3.17 correct count-pairs (define (count-pairs lst) (let ((pairlist '()) (count 0)) (define (mark-pair pair) (set! pairlist (cons pair pairlist)) (set! count (+ count 1))) (define (subcount pair) (cond ((not (pair? pair)) 'done) ((memq pair pairlist) 'done) (else (mark-pair pair) (subcount (car pair)) (subcount (cdr pair))))) (subcount lst) count)) The list structure in pairlist can get very complicated, especially if the original structure is complicated, but it doesn't matter. The cdrs of pairlist form a straightforward, non-circular list; the cars may point to anything, but we don't follow down the deep structure of the cars. We use memq, which sees if PAIR (a pair) is eq? (NOT equal?) to the car of some sublist of pairlist. Eq? doesn't care about the contents of a pair; it just looks to see if the two arguments are the very same pair--the same location in the computer's memory. [Non-experts can stop here and go on to the next problem. The following optional material is just for experts, for a deeper understanding.] It's not necessary to use local state and mutation. That just makes the problem easier. The reason is that a general list structure isn't a sequence; it's essentially a binary tree of pairs (with non-pairs as the leaves). So you have to have some way to have the pairs you encounter in the left branch still remembered as you traverse the right branch. The easiest way to do this is to remember all the pairs in a variable that's declared outside the SUBCOUNT procedure, so it's not local to a particular subtree. But another way to do it is to have a more complicated helper procedure that takes PAIRLIST as an argument, but also sequentializes the traversal by keeping a list of yet-unvisited nodes, sort of like the breadth-first tree traversal procedure (although this goes depth-first because TODO is a stack, not a queue): (define (count-pairs lst) (define (helper pair pairlist count todo) (if (or (not (pair? pair)) (memq pair pairlist)) ; New pair? (if (null? todo) ; No. More pairs? count ; No. Finished. (helper (car todo) pairlist count (cdr todo))) ; Yes, pop one. (helper (car pair) (cons pair pairlist) (+ count 1) ; Yes, count it, (cons (cdr pair) todo)))) ; do car, push cdr (helper lst '() 0 '())) As you're reading this code, keep in mind that all the calls to HELPER are tail calls, so this is an iterative process, unlike the solution using mutation, in which the call (SUBCOUNT (CAR PAIR)) isn't a tail call and so that solution generates a recursive process. And after you understand that version, try this one: (define (count-pairs lst) (define (helper pair pairlist count todo) (if (or (not (pair? pair)) (memq pair pairlist)) ; New pair? (todo pairlist count) ; No. Continue. (helper (car pair) (cons pair pairlist) (+ count 1) ; Yes, count it, (lambda (pairlist count) ; do car, push cdr (helper (cdr pair) pairlist count todo))))) (helper lst '() 0 (lambda (pairlist count) count))) Here, instead of being a list of waiting pairs, TODO is a procedure that knows what tasks remain. The name for such a procedure is a "continuation" because it says how to continue after doing some piece of the problem. This is an example of "continuation-passing style" (CPS). Since TODO is tail-called, you can think of it as the target of a goto, if you've used languages with that feature. 3.21 print-queue The extra pair used as the head of the queue has as its car an ordinary list of all the items in the queue, and as its cdr a singleton list of the last element of the queue. Each of Ben's examples print as a list of two members; the first member is a list containing all the items in the queue, and the second member is just the last item in the queue. If you look at what Ben printed, take its car and you'll get the queue items; take its cdr and you'll get a list of one member, namely the last queue item. The only exception is Ben's last example. In that case, the car of what Ben prints correctly indicates that the queue is empty, but the cdr still contains the former last item. This is explained by footnote 22 on page 265, which says that we don't bother updating the rear-ptr when we delete the last (or any) member of the queue because a null front-ptr is good enough to tell us the queue is empty. It's quite easy to print the sequence of items in the queue: (define print-queue front-ptr) 3.25 multi-key table Several students generalized the message-passing table implementation from page 271, which is fine, but it's also fine (and a little easier) to generalize the simpler version of page 270: (define (lookup keylist table) (cond ((not table) #f) ((null? keylist) (cdr table)) (else (lookup (cdr keylist) (assoc (car keylist) (cdr table)))))) (define (insert! keylist value table) (if (null? keylist) (set-cdr! table value) (let ((record (assoc (car keylist) (cdr table)))) (if (not record) (begin (set-cdr! table (cons (list (car keylist)) (cdr table))) (insert! (cdr keylist) value (cadr table))) (insert! (cdr keylist) value record))))) That solution assumes all the entries are compatible. If you say (insert! '(a) 'a-value my-table) (insert! '(a b) 'ab-value my-table) the second call will fail because it will try to (assoc 'b (cdr 'a-value)) and the CDR will cause an error. If you'd like to be able to have values for both (a) and (a b), the solution is more complicated; each table entry must contain both a value and a subtable. In the version above, each association list entry is a pair whose CAR is a key and whose CDR is *either* a value or a subtable. In the version below, each association list entry is a pair whose CAR is a key and whose CDR is *another pair* whose CAR is a value (initially #f) and whose CDR is a subtable (initially empty). Changes are in CAPITALS below: (define (lookup keylist table) (cond ; *** the clause ((not table) #f) is no longer needed ((null? keylist) (CAR table)) ; *** (else (LET ((RECORD (assoc (car keylist) (cdr table)))) (IF (NOT RECORD) #F (lookup (cdr keylist) (CDR RECORD))))))) ; *** (define (insert! keylist value table) (if (null? keylist) (SET-CAR! table value) ; *** (let ((record (assoc (car keylist) (cdr table)))) (if (not record) (begin (set-cdr! table (cons (LIST (CAR keylist) #F) (cdr table))) ; *** (insert! (cdr keylist) value (CDADR table))) (insert! (cdr keylist) value (CDR RECORD)))))) ; *** Note: In a sense, this problem can be solved without doing any work at all. In a problem like (lookup '(red blue green) color-table) you can think of (red blue green) as a list of three keys, each of which is a word, or as a single key containing three words! So the original one-dimensional implementation will accept this as a key. However, for a large enough table, this would be inefficient because you have to look through a very long list of length Theta(n^3) instead of three lists each Theta(n) long. 3.27 Memoization Here's what happened when I tried it, with annotations in [brackets]. In the annotations, (fib n) really means that (memo-fib n) is called! I just said "fib" to save space. > (memo-fib 3) "CALLED" memo-fib 3 [user calls (fib 3)] "CALLED" lookup 3 (*table*) "RETURNED" lookup #f "CALLED" memo-fib 2 [(fib 3) calls (fib 2)] "CALLED" lookup 2 (*table*) "RETURNED" lookup #f "CALLED" memo-fib 1 [(fib 2) calls (fib 1)] "CALLED" lookup 1 (*table*) "RETURNED" lookup #f "CALLED" insert! 1 1 (*table*) "RETURNED" insert! ok "RETURNED" memo-fib 1 [(fib 1) returns 1] "CALLED" memo-fib 0 [(fib 2) calls (fib 0)] "CALLED" lookup 0 (*table* (1 . 1)) "RETURNED" lookup #f "CALLED" insert! 0 0 (*table* (1 . 1)) "RETURNED" insert! ok "RETURNED" memo-fib 0 [(fib 0) returns 0] "CALLED" insert! 2 1 (*table* (0 . 0) (1 . 1)) "RETURNED" insert! ok "RETURNED" memo-fib 1 [(fib 2) returns 1] "CALLED" memo-fib 1 [(fib 3) calls (fib 1) ****] "CALLED" lookup 1 (*table* (2 . 1) (0 . 0) (1 . 1)) "RETURNED" lookup 1 "RETURNED" memo-fib 1 [(fib 1) returns 1] "CALLED" insert! 3 2 (*table* (2 . 1) (0 . 0) (1 . 1)) "RETURNED" insert! ok "RETURNED" memo-fib 2 [(fib 3) returns 2] 2 The line marked **** above is the only call to memo-fib in this example in which the memoization actually finds a previous value. We are computing (fib 1) for the second time, so memo-fib finds it in the table. In general, calling memo-fib for some larger argument will result in two recursive calls for each smaller argument value. For example: fib 6 ---> fib 5, fib 4 fib 5 ---> fib 4, fib 3 fib 4 ---> fib 3, fib 2 and so on. (memo-fib 4) is evaluated once directly from (memo-fib 6) and once from (memo-fib 5). But only one of those actually requires any computation; the other finds the value in the table. This is why memo-fib takes Theta(n) time: it does about 2n recursive calls, half of which are satisfied by values found in the table. If we didn't use memoization, or if we defined memo-fib to be (memoize fib), we would have had to compute (f 1) twice. In this case there would only be one duplicated computation, but the number grows exponentially; for (fib 4) we have to compute (fib 2) twice and (fib 1) three times. By the way, notice that if we try (memo-fib 3) a second time from the Scheme prompt, we get a result immediately: > (memo-fib 3) "CALLED" memo-fib 3 "CALLED" lookup 3 (*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1)) "RETURNED" lookup 2 "RETURNED" memo-fib 2 2 Scheme-2 set!: This is actually tricky -- I got it wrong the first time I tried it. The trouble is that the procedure PUT in scheme2.scm, which was written for use by DEFINE, doesn't modify an existing binding, and therefore isn't useful for implementing SET!. But it's not a good idea to change PUT, because that breaks DEFINE. We want a DEFINE in an inner environment (that is, a DEFINE in a procedure body) to make a new variable, even if a variable with the same name exists in the global environment. This is why PUT always adds a new binding, not checking for an old one. But SET! should *only* modify an existing binding, not create a new one. We change eval-2 like this: (define (eval-2 exp env) (cond ... ((define-exp? exp) (put (define-variable exp) (eval-2 (define-value exp) env) env) 'okay) ((SET!-EXP? EXP) (SET-PUT (CADR EXP) (EVAL-2 (CADDR EXP) ENV) ENV) 'OKAY) ...)) Then we define SET-PUT: (define (set-put var val env) (let ((pair (assoc var (cdr env)))) (if pair (set-cdr! pair val) (error "No such variable: " var)))) Scheme-2 bug: This is a complicated diagram, and I'm going to abbreviate it by not showing the pairs that are inside lambda expressions. The notation (\x) below means (lambda (x) ...). GLOBAL ENV ----> XX--->XX----------------->XX--------------------->X/ +----/ ---^ | | | +-^ | | +--/ V V V ! V | | *TABLE* XX XX ! XX | | | \ | \ ! | \ | | V V V V ! V | | | g XX--->XX--->X/ h XX--->XX--->X/ ! f | | | | | | | | | ! | | | V V | V V | ! | | | PROC (\z) | PROC (\y) | ! | | | | | ! | | +-----------------------------+ | ! | | +-+ ! | | | ! | | | ! | | V ! | | env for (f 3)----------> XX--->XX | | | +-^| | | V | V | | *TABLE*| XX | | | / \ | | env for (h 4)--------> XX--->XX------------+ V V | | | | x 3 | | V V +-----------------+ | *TABLE* XX V | / \ XX--->XX--->X/ | V V | | | | y 4 PROC (\x) | +----------------------------------------------------------+ The problem is with the vertical arrow made of exclamation points near the right of the picture. It tells us that the environment created by the call (f 3) extends the global environment *as it exists at the time of this procedure call*! So the new environment has a new binding for X, and the existing binding for F. This is the environment that procedure H remembers, so when we call (h 4), within the body of H the bindings of G and H are invisible. The whole point of this exercise is to convince you that it's not good enough to represent an environment as a list of bindings. We have to represent it as a list of frames, each of which is a list of bindings. This is how the textbook does it, in week 12. Vector exercises: 1. VECTOR-APPEND is basically like VECTOR-CONS in the notes, except that we need two loops, one for each source vector: (define (vector-append vec1 vec2) (define (loop newvec vec n i) (if (>= n 0) (begin (vector-set! newvec i (vector-ref vec n)) (loop newvec vec (- n 1) (- i 1))))) (let ((result (make-vector (+ (vector-length vec1) (vector-length vec2))))) (loop result vec1 (- (vector-length vec1) 1) (- (vector-length vec1) 1)) (loop result vec2 (- (vector-length vec2) 1) (- (vector-length result) 1)) result)) 2. VECTOR-FILTER is tough because we have to do the filtering twice, first to get the length of the desired result vector, then again to fill in the slots: (define (vector-filter pred vec) (define (get-length n) (cond ((< n 0) 0) ((pred (vector-ref vec n)) (+ 1 (get-length (- n 1)))) (else (get-length (- n 1))))) (define (loop newvec n i) (cond ((< n 0) newvec) ((pred (vector-ref vec n)) (vector-set! newvec i (vector-ref vec n)) (loop newvec (- n 1) (- i 1))) (else (loop newvec (- n 1) i)))) (let ((newlen (get-length (- (vector-length vec) 1)))) (loop (make-vector newlen) (- (vector-length vec) 1) (- newlen 1)))) 3. Bubble sort is notorious because nobody ever uses it in practice, because it's slow, but it always appears in programming course exercises, because the operation of swapping two neighboring elements is relatively easy to write. (a) Here's the program: (define (bubble-sort! vec) (let ((len (vector-length vec))) (define (loop n) (define (bubble k) (if (= k n) 'one-pass-done (let ((left (vector-ref vec (- k 1))) (right (vector-ref vec k))) (if (> left right) (begin (vector-set! vec (- k 1) right) (vector-set! vec k left))) (bubble (+ k 1))))) (if (< n 2) vec (begin (bubble 1) (loop (- n 1))))) (loop len))) (b) As the hint says, we start by proving that after calling (bubble 1) inside the call to (loop n), element number n-1 is greater than any element to its left. (Bubble 1) reorders elements 0 and 1 so that vec[0] is less than or equal to vec[1] (I'm using C/Java notation for elements of vectors), then reorders elements 1 (the *new* element 1, which is the larger of the original first two elements) and element 2 so that vec[1] is less than or equal to vec[2]. It continues, but let's stop here for the moment. After those two steps, the new vec[2] is at least as large as vec[1]. But the intermediate value of vec[1] was larger than the new vec[0], so vec[2] must be the largest. This might be clearer with a chart. There are six possible original orderings of the first three elements; here they are, with the ordering after the 0/1 swap and the ordering after the 1/2 swap. (To make the table narrower, I've renamed VEC as V. Also, I'm calling the three values 0, 1, and 2; it doesn't matter what the actual values are, as long as they are in the same order as a particular line in the table.) original after 0/1 swap after 1/2 swap -------------- -------------- -------------- v[0] v[1] v[2] v[0] v[1] v[2] v[0] v[1] v[2] ---- ---- ---- ---- ---- ---- ---- ---- ---- 0 1 2 0 1 2 0 1 2 0 2 1 0 2 1 0 1 2 1 0 2 0 1 2 0 1 2 1 2 0 1 2 0 1 0 2 2 0 1 0 2 1 0 1 2 2 1 0 1 2 0 1 0 2 After the first swap, we have v[0] <= v[1]. After the second swap, we have v[1] <= v[2]. But note that there is no guarantee about the order of the final v[0] and v[1]! All that's guaranteed is that the largest of the three values is now in v[2]. Similarly, after the 2/3 swap, we know that vec[3] is the largest of the first four values, because either the original vec[3] was already largest, in which case there is no swap, or the value of vec[2] just before the 2/3 swap is the largest of the original vec[0] through vec[2], so it's the largest of vec[0] through vec[3] and will rightly end up as the new vec[3]. Subprocedure BUBBLE calls itself recursively until k=n, which means that vec[n-1] is the largest of the first n elements. QED. Now, if that's true about a single pass, then the first pass "bubbles" the largest number to the end of the vector (this is why it's called bubble sort), and then we call LOOP recursively to sort the remaining elements. The second pass gets vec[len-2] to be the largest of the first len-1 elements, etc. After LEN passes, the entire vector is sorted. This was a handwavy proof. To make it rigorous, it'd be done by mathematical induction -- two inductions, one for the swaps in a single pass, and one for the multiple passes. (c) It's Theta(N^2), for the usual reason: N passes, each of which takes time Theta(N). Extra for experts ----------------- 3.19 constant-space cycle? predicate Just to make sure you understand the issue, let me first do 3.18, which asks us to write cycle? without imposing a constant-space requirement. It's a lot like the correct version of count-pairs; it has to keep track of which pairs we've seen already. (define (cycle? lst) (define (iter lst pairlist) (cond ((not (pair? lst)) #f) ((memq lst pairlist) #t) (else (iter (cdr lst) (cons lst pairlist))))) (iter lst '())) This is simpler than count-pairs because we only have to chase down pointers in one direction (the cdr) instead of two, so it can be done iteratively. I check (not (pair? lst)) rather than (null? lst) so that the program won't blow up on a list structure like (a . b) by trying to take the cdr of b. The trouble is that the list pairlist will grow to be the same size as the argument list, if the latter doesn't contain a cycle. What we need is to find a way to keep the auxiliary list of already-seen pairs without using up any extra space. Here is the very cleverest possible solution: (define (cycle? lst) (define (iter fast slow) (cond ((not (pair? fast)) #f) ((not (pair? (cdr fast))) #f) ((eq? fast slow) #t) (else (iter (cddr fast) (cdr slow))) )) (if (not (pair? lst)) #f (iter (cdr lst) lst) )) This solution runs in Theta(1) space and Theta(n) time. We send two pointers CDRing down the list at different speeds. If the list is not a cycle, the faster one will eventually hit the end of the list, and we'll return false. If the list is a cycle, the faster one will eventually overtake the slower one, and we'll return true. (You may think that this will only work for odd-length cycles, or only for even-length cycles, because in the opposite case the fast pointer will leapfrog over the slow one, but if that happens the two pointers will become equal on the next iteration.) If you didn't come up with this solution, don't be upset; most folks don't. This is a classic problem, and struggling with it is a sort of initiation ritual in the Lisp community. Here's a less clever solution that runs in Theta(1) space but needs Theta(n^2) time. It is like the first solution, the one that uses an auxiliary pairlist, but the clever idea is to use the argument list itself as the pairlist. This can be done by clobbering its cdr pointers temporarily. It's important to make sure we put the list back together again before we leave! The idea is that at any time we will have looked at some initial sublist of the argument, and we'll know for sure that that part is cycle-free. We keep the tested part and the untested part separate by changing the cdr of the last tested pair to the empty list, remembering the old cdr in the single extra pointer variable that this algorithm requires. (define (cycle? lst) (define (subq? x list) (cond ((null? list) #f) ((eq? x list) #t) (else (subq? x (cdr list))))) (define (iter lst pairlist pairlist-tail) (cond ((not (pair? lst)) (set-cdr! pairlist-tail lst) #f) ((subq? lst pairlist) (set-cdr! pairlist-tail lst) #t) (else (let ((oldcdr (cdr lst))) (set-cdr! pairlist-tail lst) (set-cdr! lst '()) (iter oldcdr pairlist lst) )))) (cond ((null? lst) #f) (else (let ((oldcdr (cdr lst))) (set-cdr! lst '()) (iter oldcdr lst lst))))) Be wary of computing (cdr lst) before you've tested whether or not lst is empty. 3.23 Double-ended queue The only tricky part here is rear-delete-deque!. All the other deque operations can be performed in Theta(1) time using exactly the same structure used for the queue in 3.3.2. The trouble with rear-delete is that in order to know where the new rear is, we have to be able to find the next-to-last member of the queue. In the 3.3.2 queue, the only way to do that is to cdr down from the front, which takes Theta(n) time for an n-item queue. To avoid that, each item in the queue must point not only to the next item but also to the previous item: +---+---+ | | | --------------------------------------------+ +-|-+---+ | | | V V +---+---+ +---+---+ +---+---+ +---+--/+ | | | --------->| | | --------->| | | --------->| | | / | +-|-+---+ +-|-+---+ +-|-+---+ +-|-+/--+ | ^ | ^ | ^ | | +-----+ | +-----+ | +-----+ | V | V | V | V +--/+---+ | +---+---+ | +---+---+ | +---+---+ | / | | | +------ | | | +------ | | | +------ | | | +/--+-|-+ +---+-|-+ +---+-|-+ +---+-|-+ | | | | V V V V a b c d Whew! The first pair, at the top of the diagram, is the deque header, just like the queue header in 3.3.2. The second row of four pairs is a regular list representing the deque entries, again just like 3.3.2. But instead of each car in the second row pointing to a queue item, each car in this second row points to another pair, whose car points to the previous element on the second row and whose cdr points to the actual item. ;; data abstractions for deque members ;; we use front-ptr, rear-ptr, set-front-ptr!, and set-rear-ptr! from p. 263 (define deque-item cdar) (define deque-fwd-ptr cdr) (define deque-back-ptr caar) (define set-deque-fwd-ptr! set-cdr!) (define (set-deque-back-ptr! member new-ptr) (set-car! (car member) new-ptr)) ;; Now the things we were asked to do: (define (make-deque) (cons '() '())) (define (empty-deque? deque) (null? (front-ptr deque))) (define (front-deque deque) (if (empty-deque? deque) (error "front-deque called with empty queue") (deque-item (front-ptr deque)))) (define (rear-deque deque) (if (empty-deque? deque) (error "rear-deque called with empty queue") (deque-item (rear-ptr deque)))) (define (front-insert-deque! deque item) (let ((new-member (list (cons '() item)))) (cond ((empty-deque? deque) (set-front-ptr! deque new-member) (set-rear-ptr! deque new-member) "done") (else (set-deque-fwd-ptr! new-member (front-ptr deque)) (set-deque-back-ptr! (front-ptr deque) new-member) (set-front-ptr! deque new-member) "done")))) (define (rear-insert-deque! deque item) (let ((new-member (list (cons '() item)))) (cond ((empty-deque? deque) (set-front-ptr! deque new-member) (set-rear-ptr! deque new-member) "done") (else (set-deque-back-ptr! new-member (rear-ptr deque)) (set-deque-fwd-ptr! (rear-ptr deque) new-member) (set-rear-ptr! deque new-member) "done")))) (define (front-delete-deque! deque) (cond ((empty-deque? deque) (error "front-delete-deque! called with empty queue")) ((null? (deque-fwd-ptr (front-ptr deque))) (set-front-ptr! deque '()) (set-rear-ptr! deque '()) "done") (else (set-deque-back-ptr! (deque-fwd-ptr (front-ptr deque)) '()) (set-front-ptr! deque (deque-fwd-ptr (front-ptr deque))) "done"))) (define (rear-delete-deque! deque) (cond ((empty-deque? deque) (error "rear-delete-deque! called with empty queue")) ((null? (deque-back-ptr (rear-ptr deque))) (set-front-ptr! deque '()) (set-rear-ptr! deque '()) "done") (else (set-deque-fwd-ptr! (deque-back-ptr (rear-ptr deque)) '()) (set-rear-ptr! deque (deque-back-ptr (rear-ptr deque))) "done"))) I could also have gotten away with leaving garbage in the rear-ptr of an emptied deque, but the ugliness involved outweighs the slight time saving to my taste. Notice an interesting property of the use of data abstraction here: at the implementation level, set-deque-back-ptr! and set-deque-fwd-ptr! are rather different, but once that difference is abstracted away, rear-delete-deque! is exactly like front-delete-deque! and ditto for the two insert procedures. The reason these procedures return "done" instead of returning deque, like the single-end queue procedures in the book, is that the deque is a circular list structure, so if we tried to print it we'd get in trouble. We should probably invent print-deque: (define (print-deque deque) (define (sub member) (if (null? member) '() (cons (deque-item member) (sub (deque-fwd-ptr member))))) (sub (front-ptr deque))) But I'd say it's a waste of time to cons up this printable list every time we insert or delete something. 2. cxr-name This is a harder problem than its inverse function cxr-function! We are given a function as a black box, not knowing how it was defined; the only way we can get any information about it is to invoke it on a cleverly chosen argument. We need three ideas here. The first one is this: Suppose we knew that we were given either CAR or CDR as the argument. We could determine which of them by applying the mystery function to a pair with the word CAR as its car, and the word CDR as its cdr: (define (simple-cxr-name fn) (fn '(car . cdr))) You might think to generalize this by building a sort of binary tree with function names at the leaves: (define (two-level-cxr-name fn) (fn '((caar . cdar) . (cadr . cddr)))) But there are two problems with this approach. First, note that this version *doesn't* work for CAR or CDR, only for functions with exactly two CARs or CDRs composed. Second, the argument function might be a composition of *any* number of CARs and CDRs, so we'd need an infinitely deep tree. So the second idea we need is a way to attack the mystery function one component at a time. We'd like the first CAR or CDR applied to our argument (that's the rightmost one, don't forget) to be the only one that affects the result; once that first choice has been made, any CARs or CDRs applied to the result shouldn't matter. The clever idea is to make a pair whose CAR and CDR both point to itself! So any composition of CARs and CDRs of this pair will still just be the same pair. Actually we'll make two of these pairs, one for the CAR of our argument pair and one for the CDR: (define car-pair (cons '() '())) (set-car! car-pair car-pair) (set-cdr! car-pair car-pair) (define cdr-pair (cons '() '())) (set-car! cdr-pair cdr-pair) (set-cdr! cdr-pair cdr-pair) (define magic-argument (cons car-pair cdr-pair)) (define (rightmost-part fn) (if (eq? (fn magic-argument) car-pair) 'car 'cdr)) It's crucial that we're using EQ? rather than EQUAL? here, since car-pair and cdr-pair are infinite (circular) lists. Okay, we know the rightmost component. How do we get all but the rightmost component? (Given that, we can recursively find the rightmost part of that, etc.) Our third clever idea is a more-magic argument that will give us magic-argument whether we take its car or its cdr: (define more-magic-arg (cons magic-argument magic-argument)) (define (next-to-rightmost-part fn) (if (eq? (fn more-magic-arg) car-pair) 'car 'cdr)) We're going to end up constructing a ladder of pairs whose car and cdr are both the next pair down the ladder. We also need a base case; if we apply fn to magic-argument and get magic-argument itself, rather than car-pair or cdr-pair, we've run out of composed CAR/CDR functions. Here's how it all fits together: (define (cxr-name fn) (word 'c (cxr-name-help fn magic-argument) 'r)) (define (cxr-name-help fn arg) (let ((result (fn arg))) (cond ((eq? result car-pair) (word (cxr-name-help fn (cons arg arg)) 'a)) ((eq? result cdr-pair) (word (cxr-name-help fn (cons arg arg)) 'd)) (else "")))) ; empty word if result is magic-argument