CS 61A -- Week 5 solutions LAB 1 ACTIVITIES: Type it in and see! Or try drawing environment diagrams and checking with EnvDraw! LAB 2 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.) HOMEWORK: 3.3 Accounts with passwords (define (make-account balance password) (define (withdraw amount) ; Starting here exactly as in p. 223 (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (dispatch pw m) ; Starting here different because of pw (cond ((not (eq? pw password)) (lambda (x) "Incorrect password")) ((eq? m 'withdraw) withdraw) ; Now the same again ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m)))) dispatch) The big question here is why withdraw can get away with returning "Insufficient funds" while dispatch has to return this complicated (lambda (x) "Incorrect password") The answer is that ordinarily the result returned by withdraw is supposed to be a number, which is just printed. In case of an error, withdraw can return a string instead, and that string will just get printed. But dispatch is ordinarily supposed to return a PROCEDURE. In the example ((acc 'some-other-password 'deposit) 50) if dispatch just returned the string, it would be as if we'd typed ("Incorrect password" 50) which makes no sense. Instead this version is as if we typed ((lambda (x) "Incorrect password") 50) which does, as desired, print the string. A simpler solution would be to say (error "Incorrect password") because the ERROR primitive stops the computation and returns to toplevel after printing its argument(s). But you should understand the version above! 3.4 call-the-cops (define (make-account balance password) (define error-count 0) ; THIS LINE ADDED (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (dispatch pw m) (cond ((eq? pw password) ; REARRANGED STARTING HERE (set! error-count 0) (cond ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m)) )) (else (set! error-count (1+ error-count)) (if (> error-count 7) (call-the-cops)) (lambda (x) "Incorrect password") ))) dispatch) In this version, call-the-cops will be invoked before the dispatch procedure goes on to return the nameless procedure that will, eventually, be invoked and print the string "Incorrect password", so whatever call-the-cops prints will appear before that message. If you'd like it to appear instead of the string, change the last few lines to (lambda (x) (if (> error-count 7) (call-the-cops) "Incorrect password")) 3.7 Joint accounts What we want here is a new dispatch procedure that has access to the same environment frame containing the balance of the original account. You could imagine a complicated scheme in which we teach make-account's dispatch procedure a new message, make-joint, such that ((acc 'old-password 'make-joint) 'new-password) will return a new dispatch procedure in a new frame with its own password binding but inheriting acc's balance binding. This can work, and we'll do it later in this solution, but it's a little tricky because you have to avoid the problem of needing to write a complete dispatch procedure within a cond clause in the dispatch procedure! Instead, one thing to do is to create a new function that invokes f from within a prepared frame. Here is a first, simple version that does almost what we want: (define (make-joint old-acc old-pw new-pw) (lambda (pw m) (if (eq? pw new-pw) (old-acc old-pw m) (lambda (x) "Incorrect password")))) It's important to understand how easy this is if we're willing to treat the old account procedure as data usable in this new make-joint procedure. This version works fine, with proper password protection, but it differs in one small detail from what the problem asked us to do. I'd be very happy with this version of the program, but for those of you who are sticklers for detail, here's a discussion of the problem and a revised solution. Suppose you don't know the password of the old account but you try to make a joint-account by guessing. Make-joint will return a procedure, without complaining, and it isn't until you try to use that returned procedure that the old account will complain about getting the wrong password. The problem says, "The second argument must match the password with which the account was defined in order for the make-joint operation to proceed." They want us to catch a password error as soon as make-joint itself is invoked. To do this, make-joint must be able to ask old-acc whether or not the given old-pw is correct. So we'd like a verify-password message so that ==> (peter-acc 'open-sesame 'verify-password) #t ==> (peter-acc 'garply 'verify-password) #f Given such a facility in make-account, we can write make-joint this way: (define (make-joint old-acc old-pw new-pw) (if (old-acc old-pw 'verify-password) (lambda (pw m) (if (eq? pw new-pw) (old-acc old-pw m) (lambda (x) "Incorrect password"))) (display "Incorrect password for old account"))) This approach only makes sense if we use (display ...) to signal the error. We can't just return a string because the string won't be printed; it'll be bound to a symbol like paul-acc as that symbol's value. Later, when we try to invoke paul-acc as a procedure, we'll get a "Application of non-procedure object" error message. We also can't just do the trick of returning (lambda (x) "string"). That won't blow up our program, but again the printing of the error message won't happen until paul-acc is applied to something. If we wanted to wait until then to see the error message, we could just use my first solution. So we're stuck with explicitly printing the message. What gets returned is whatever print returns; if we ignore the message and try to invoke paul-acc later, it'll blow up. To make this work we need to invent the verify-password message: (define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (dispatch pw m) (cond ((eq? m 'verify-password) ; This clause is new (eq? pw password)) ((not (eq? pw password)) (lambda (x) "Incorrect password")) ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) (else (error "Unknown request -- MAKE-ACCOUNT" m)))) dispatch) Note the order of the cond clauses in dispatch. The verify-password message is not considered an error even if the password doesn't match; it just returns #f in that case. So we first check for that message, then if not we check for an incorrect password, then if not we check for the other messages. If you want to add a make-joint message to the account dispatch procedure, the corresponding method has to return a new dispatch procedure. This is the approach that I rejected earlier as too complicated, but it's not bad once you understand how to do it: instead of having a (define (dispatch pw m) ...) so that there is one fixed dispatch procedure, you do the object-oriented trick of allowing multiple dispatch procedure objects, so we have a higher-order procedure that makes dispatch procedures. Every time a new person is added to the account, we make a new dispatch procedure for that person, with a new password. Even the first user of the account gets a dispatch procedure through this mechanism, as you'll see below: (define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (new-dispatch new-pw) ; This is new. We have a dispatch maker (lambda (pw m) ; instead of just one dispatch procedure. (cond ((not (eq? pw new-pw)) (lambda (x) "Incorrect password")) ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) ((eq? m 'make-joint) new-dispatch) (else (error "Unknown request -- MAKE-ACCOUNT" m))))) (new-dispatch password)) ; We have to make a dispatcher the first time too. 3.8 Procedure for which order of evaluation of args matters The procedure f will be invoked twice. We want the results to depend on the past invocation history. That is, (f 1) should have a different value depending on whether or not f has been invoked before. Given the particular values we're supposed to produce, I think the easiest thing is if (f 0) is always 0, while (f 1) is 1 if (f 0) hasn't been invoked or 0 if it has. (define f (let ((history 1)) (lambda (x) (set! history (* history x)) history))) If we evaluate (f 1) first, then history has the value 1, and the result (and new value of history) is (* 1 1) which is 1. On the other hand, if we evaluate (f 0) first, that sets history to 0, so a later (f 1) returns (* 0 1) which is 0. The above solution only works the first time we try (+ (f 0) (f 1)) however. After the first time, (f x) always returns 0 for any x. Here's another solution that doesn't have that defect: (define f (let ((invocations 0)) (lambda (x) (set! invocations (1+ invocations)) (cond ((= x 0) 0) ((even? invocations) 0) (else 1))))) Many other possible solutions are equally good. 3.10 Let vs. parameter args: initial-amount --> body: (let ...) global env: | |------------------------------| | | make-withdraw: --------------------> (function) --> global env | | | W1: -- (this pointer added later) -> (function A below) | | | W2: -- (this one added later too) -> (function B below) |------------------------------| The first invocation of make-withdraw creates a frame E1: |--------------------| |initial-amount: 100 |---> global env |--------------------| and in that frame evaluates the let, which makes an unnamed function (function) --> E1 | | args: balance ---> body: (lambda (amount) ...) then the same let applies the unnamed function to the argument expression initial-amount. We are still in frame E1 so initial-amount has value 100. To apply the function we make a new frame: E2: |--------------------| |balance: 100 |---> E1 |--------------------| Then in that frame we evaluate the body, the lambda expression: (function A) --> E2 | | args: amount ---> body: (if ...) Then the outer define makes global W1 point to this function. Now we do (W1 50). This creates a frame: E3: |------------| |amount: 50 |---> E2 |------------| Frame E3 points to E2 because function A (i.e. W1) points to E2. Within frame E3 we evaluate the body of function A, the (if ...). During this evaluation the symbol AMOUNT is bound in E3, while BALANCE is bound in E2. So the set! changes BALANCE in E2 from 100 to 50. Now we make W2, creating two new frames in the process: E4: |--------------------| |initial-amount: 100 |---> global env |--------------------| (function) --> E4 | | args: balance ---> body: (lambda (amount) ...) E5: |--------------------| |balance: 100 |---> E4 |--------------------| (function B) --> E5 | | args: amount ---> body: (if ...) Then the outer define makes global W2 point to this function. Summary: the two versions of make-withdraw create objects with the same behavior because in each case the functions A and B are defined within individual frames that bind BALANCE. The environment structures differ because this new version has, for each account, an extra frame containing the binding for initial-amount. ================================================== 3.11 Message-passing example global env: |------------------------------| | make-account: --------------------> (function) ---> global env | | | acc: --(pointer added later)------> (function A below) |------------------------------| When we (define acc (make-account 50)), a new frame is created that includes both make-account's parameters (balance) and its internal definitions (withdraw, deposit, dispatch): E1: |------------------------------| | balance: 50 |----> global env | | | withdraw: -------------------------> (function W) ---> E1 | | | deposit: --------------------------> (function D) ---> E1 | | | dispatch: -------------------------> (function A) ---> E1 |------------------------------| (The arrow I have in the top right corner has nothing to do with the binding of BALANCE; it's the back pointer for this frame.) At this point the symbol ACC is bound, in the global environment, to function A. Now we do ((acc 'deposit) 40). E2: |--------------------| | m: deposit |----> E1 |--------------------| The above results from evaluating (acc 'deposit), whose returned value is function D above. E3: |--------------------| | amount: 40 |----> E1 |--------------------| The above frame results from (D 40) [so to speak]. Note that its back pointer points to E1, not E2, because that's what D points to. Now we evaluate the body of D, which includes (set! balance (+ balance amount)) The value for AMOUNT comes from E3, and the value for BALANCE from E1. The set! changes the value to which BALANCE is bound in E1, from 50 to 90. ((acc 'withdraw) 60) similarly creates two new frames: E4: |--------------------| | m: withdraw |----> E1 |--------------------| E5: |--------------------| | amount: 60 |----> E1 |--------------------| Again BALANCE is changed in E1, which is where ACC's local state is kept. If we define another account ACC2, we'll produce a new frame E6 that has the same symbols bound that E1 does, but bound to different things. The only shared environment frame between ACC1 and ACC2 is the global environment. The functions in E6 are *not* the same as the functions D, W, and A in E1. (They may, depending on the implementation, have the same list structure as their bodies, but they don't have the same environment pointers.) 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 nil) (count 0)) (define (mark-pair lst) (set! pairlist (cons lst pairlist)) (set! count (1+ count))) (define (subcount lst) (cond ((not (pair? lst)) #f) ((memq lst pairlist) #f) (else (mark-pair lst) (subcount (car lst)) (subcount (cdr lst))))) (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 lst (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. 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 nil 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.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 EXTRA PRACTICE 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) (define (iter sublist subtable) (cond ((not subtable) #f) ((null? sublist) (cdr subtable)) (else (iter (cdr sublist) (assoc (car sublist) (cdr subtable)))))) (iter keylist table)) (define (insert! keylist value table) (define (iter sublist subtable) (if (null? sublist) (set-cdr! subtable value) (let ((record (assoc (car sublist) (cdr subtable)))) (if (not record) (sequence (set-cdr! subtable (cons (list (car sublist)) (cdr subtable))) (iter (cdr sublist) (cadr subtable))) (iter (cdr sublist) record))))) (iter keylist table)) 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. 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 nil)) 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 nil, 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 nil nil)) (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 nil 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 nil 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 nil) (set-rear-ptr! deque nil) "done") (else (set-deque-back-ptr! (deque-fwd-ptr (front-ptr deque)) nil) (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 nil) (set-rear-ptr! deque nil) "done") (else (set-deque-fwd-ptr! (deque-back-ptr (rear-ptr deque)) nil) (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) nil (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.