diff options
Diffstat (limited to 'js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10')
| -rw-r--r-- | js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 | 977 |
1 files changed, 977 insertions, 0 deletions
diff --git a/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 new file mode 100644 index 0000000..53e4817 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/61a-pages/Solutions/week10 @@ -0,0 +1,977 @@ +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 <anything>). 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 |