第伍章學題 Lisp 3rd Edition, Winston & Horn

5-1: Ignoring the existence of NTHCDR, the primitive supplied by LISP itself, write a tail recursive, SKIP-FIRST-N that trims off the first n elements from a list and return the rest:

* (skip-first-n 3 '(a b c d e f g h i))

(D E F G H I)

5-2: Write a procedure, KEEP-FIRST-N, not tail recursive, that reutrns a list of the first n elements in a list.  You may assume there are at least n elements.

* (keep-first-n 3 '(a b c d e f g h i))

(A B C)

5-3: Now write a pair of procedures KEEP-FIRST-N-CLEVERLY and KEEP-FIRST-N-CLEVERLY-AUX, that together make a list of the first n elements in a list.  Be sure that KEEP-FIRST-N-CLEVERLY-AUX is tail recursive.

5-4: The Lisp primitives 1+ and 1- increment and decrement a number by one.  Using  1+ and 1-, write a recursive procedure, ADD, for adding two numbers without +.  Assume that both numbers are positive.

5-5: An ancient myth has it that in some temple in Hanoi, time is marked off by monks engaged in the transfer of 64 disks from one of three pins to another, as shown in figure 5-6.  The universe as we know it will end when they are done.  The reason we do not have to concern ourselves about the cosmological implications of this is that their progress is kept in check by some clever rules:

* Only one disk can be moved at a time.

* The disks all have different diameters, and no disk can ever be placed on top of a smaller one.

* Initially all disks are on one pin and each disk rests on a larger one.

The insight leading to the correct sequence of moves comes from the realization that a set of n disks can be transfered from pin A to pin B in these stages: first move the top (n-1) disks from A to the space pin C; then move the large bottom disk from A to B; and finally, move the (n-1) disks from the spare pin, C, onto pin B.  Naturally, moving the (n-1) disks from C to B can bedone by the same trick, using pin A as workspace.

    Suppose TOWER-OF-HANOI is to count the number of moves required to move a list of pins from one pin to another, give a list of disks:

* (tower-of-hanoi '(1))

1

* (tower-of-hanoi '(2 1))

3

* (tower-of-hanoi '(3 2 1))

7

* (tower-of-hanoi '(4 3 2 1))

15

* (tower-of-hanoi '(5 4 3 2 1))

31

* (tower-of-hanoi '(10 9 8 7 6 5 4 3 2 1))

1023

Define TOWER-OF-HANOI.

5-6: Describe the evident purpose of the following procedure:

(defun mystery (s)

   (cond ((null s) 1)

            ((atom s) 0)

            (t (max (+ (mystery (first s)) 1)

                       (mystery (rest s))))))

5-7: Describe the evident purpose of the following procedure:

(Defun strange (l)

    (cond ((null l) nil)

             ((atom l) l)

             (t (cons (strange (first l))

                         (strange (rest l))))))

5-8: Define PRESENTP, a predicate that determines whether a given atom occurs anywhere in an expression.  PRESENTP differs from MEMBER, in that MEMBER looks only for top-level instances.  Symbolic-mathematics systems make use of a procedure like PRESENTP to determine if an expression contains a particular variable.  Here are two examples:

* (setf formula '(sqrt (/ (+ (expt x 2) (expt y 2)) 2)))

* (presentp 'x formula)

T

* (presentp 'z formula)

NIL

5-9: Define SQUASH, a procedure that takes an expression as its argument and returns a nonnested list of all atoms found in the expression.  Here is an example:

* (squash '(a (a (a (a b))) (((a b) b) b) b))

(A A A A B A B B B B)

Essentially, this procedure explores the fringe of the tree represented by the list given as its argument, and reutrns a list of all the leaves.

5-10: A particular definition of a mathematical function, like the Fibonacci function, may directly suggest a Lisp procedure for computing it.  This is of course not the only, and quite often not the best, procedure.  For the Fibonacci function, we can solve a linear recurrence relation for f(n).  We obtain Binet's formula in terms of the gold ratio, ((1+ √ 5)/2), and its inverse, ((1− √ 5)/2):

f(n)=(1/sqrt{5}) * [(( (1+sqrt{5})/2 )^{n+1}) - (( (1-sqrt{5})/2 )^{n+1})].

Write a version of FIBONACCI that does the computation directly, without recursion.

5-11: Suppose that we have a procedure that attaches the symbol PERIOD to the end of a list:

(defun punctuate (l)  (append l '(period)))

Naturally, it is easy to add other procedures that add QUESTION-MARK or EXCLAMATION-MARK instead.  Alternatively, we can write PUNCTUATE so that it takes a second argument:

(defun punctuate (l mark) (append l (list mark)))

Most sentences end with a period, however, so supplying the second argument every time is annoying.  Happily, the optional arguments feature enables you to supply the second argument only when needed.  Define a version of PUNCTUATE that takes an optional argument such that it works as follows:

* (punctuate '(this is an example))

(THIS IS AN EXAMPLE PERIOD)

* (punctuate '(is this an example) 'question-mark)

(IS THIS AN EXAMPLE QUESTION-MARK)

5-12: The version of FIBONACCI we have already exhibited is inefficient beyond description.  Many cdomputations are repeated.  Write a version with optional parameters that does not have this flaw.  Think of working forward from the first month rather than backward from the nth month.

5-13: Define TAIL-RECURSIVE-EXPT, a version of RECURSIVE-EXPT that is tail recursive.  Use an optional parameter to accumulate partial results.  This approach represents a common way of turning a singly recursive procedure into a tail recursive procedure.

5-14: Define TAIL-RECURSIVE-REVERSE, ignoring the existence of REVERSE, a primitive supplied by Lisp itself.  Use the same approach as in the previous problem.

5-15: Define CLEVER-COUNT-ATOMS a version of COUNT-ATOMS that uses an optional parameter to hang onto the count accumulated so fat in exploring one part of the tree.

5-16: Define USER-DEFINED-LIST to do what the primitive LIST does.  Use a rest parameter.

5-17: Define USER-DEFINED-NTHCDR in terms of IF, ZEROP, -, and REST.

5-18: Define USER-DEFINED-LAST in terms of IF, ENDP, and REST.

PROCEDURE ABSTRACTION AND RECURSION
-------------------------------------------------------------------------

Procedure Abstraction Hides Details Behind Abstraction Boundaries

* (setf l '(breakfast lunch tea dinner))
* (both-ends l)
(BREAKFAST DINNER)

(defun both-ends (whole-list)   ;Procedure abstraction version.
  (combine-elements                  ;Combine first and last.
    (extract-first-element whole-list)   ;Extract first element.
    (extract-last-element whole-list)   ;Extract last element.

(defun combine-elements (e1 e2)
  (list e1 e2))
(defun extract-first-element (l)
  (first l))
(defun extract-last-element (l)
  (first (last l)))

(defun combine-elements (e1 e2)
  (cons e1 (cons e2 nil)))
(defun extract-first-element (l)
  (car l))
(defun extract-last-element (l)
  (first (reverse l)))
-------------------------------------------------------------------------------------

Recursion Allows Procedures To Use Themselves

(defun higher-level-expt (m n)
  (if (zerop n)
      1    ;If N=0, return 1.
      (* m    ;Otherwise, use a lower-level abstraction.
         (lower-level-expt m (- n 1)))))

(defun lower-level-expt (m n)
  (higher-level-expt m n))

(defun higher-level-expt (m n)
  (if (zerop n)
      1
      (* m
         (high-level-expt m (- n 1)))))   ;Substitution.

(defun recursive-expt (m n)
  (if (zerop n)
      1    ;If N=0, return 1.
      (* m    ;Otherwise, multiply M times the result using a smaller exponent.
         (recursive-expt m (- n 1)))))

(defun fibonacci (n)
  (if (or (= n 0) (= n 1))    ;If N=0 or 1.
      1    ;Return 1.
      (+ (fibonacci (- n 1))    ;Otherwise recurse using N-1 and N-2.
         (fibonacci (- n 2)))))

(defun count-elements (l)
  (if (endp l)    ;Empty list?
      0    ;Empty list has zero elements.
      (+ 1    ;Add one to the number in the rest of L.
         (count-elements (rest l)))))

* (count-elements '(fast computers are nice))
4
---------------------------------------------------------------------------------

Recursion Can Be Efficient

(defun count-elements-cleverly (l)
  (count-elements-cleverly-aux l 0))
(defun count-elements-cleverly-aux (l result)
  (if (endp l)
      result
      (count-elements-cleverly-aux (rest l) (+ 1 result))))

(defun count-elements-cleverly (l)
  (count-elements-cleverly-indirectly l 0))
(defun count-elements-cleverly-indirectly (l result)
  (if (endp l)
      result
      (count-elements-cleverly-buffer (rest l) (+ 1 result))))
(defun count-elements-buffer (l result)
  (count-elements-indirectly l result))
------------------------------------------------------------------------------------

Recursion Can Be Used to Analyze Nested Expressions

* (count-atoms '(sqrt (expt x 2) (expt y 2)))
7

(defun count-atoms (l)
  (cond ((null l) 0)   ;L is an empty list?
        ((atom l) 1)    ;L is an atom?
        (t (+ (count-atoms (first l))    ;L must be a list; recurse.
              (count-atoms (rest l))))))
------------------------------------------------------------------------------------------

Optional Parameters Eliminate the Need for Many Auxiliaries

* (root 9)
3.0
* (root 9 2)
3.0
* (root 27 3)
3.0

(defun root (x &optional n)
  (if n
      (expt x (/ 1 n))
      (sqrt x)))

* (root 9)
3.0   ;Uses SQRT; N bound to NIL.

* (root 27 3)
3.0    ;Uses EXPT; N bound to 3.

(defun root (x &optional (n 2))
  (expt x (/ 1 n)))

* (root 9)
3.0    ;Uses EXPT; N bound to 2.

* (root 27 3)
3.0    ;Uses EXPT; N bound to 3.

(defun count-with-optional-parameter (l &optional (result 0))
  (if (endp l)
      result
      (count-with-optional-parameter (rest l)
                                    (+ 1 result))))
---------------------------------------------------------------------------------------

Advanced Programmers Use Rest, Key, and Aux Parameters

* (raise 2)
2    ;2.
* (raise 2 3)
8    ;2^3.
* (raise 2 3 5)
32768    ;(2^3)^5.

(defun raise-aux (result number-list)
  (if (endp number-list)
      result
      (raise-aux (expt result (first number-list))
                 (rest number-list))))

(defun raise (x &rest numbers)
  (raise-aux x numbers))

* (rotate-list '(a b c d e))
(E A B C D)

* (rotate-list '(a b c d e) :direction 'left)
(B C D E A)

* (rotate-list '(a b c d e) :distance 2)
(D E A B C)

* (rotate-list '(a b c d e) :direction 'left :distance 2)
(D E A B C)

(defun rotate-list (l &key direction distance)    ;First version
  (if (eq direction 'left)
      (rotate-list-left l (if distance distance 1))
      (rotate-list-right l (if distance distance 1))))
(defun rotate-list-right (l n)
  (if (zerop n)
      l
      (rotate-list-right (append (last l) (butlast l))
                         (- n 1))))
(defun rotate-list-left (l n)
  (if (zerop n)
      l
      (rotate-list-left (append (rest l) (list (first l)))
                        (- n 1))))

* (rotate-list '(a b c d e) :direction 'left :distance 2)
* (rotate-list '(a b c d e) :distance 2 :direction 'left)

(defun rotate-list (l &key direction (distance 1))   ;Better version.
  (if (eq direction 'left)
      (rotate-list-left l distance)
      (rotate-list-right l distance)))

(defun both-ends-with-let (whole-list)
  (let* ((element (first whole-list))
         (trailer (last whole-list)))
    (cons element trailer)))

(defun both-ends-with-aux
       (whole-list &aux
                   (element (first whole-list))
                   (trailer (last whole-list)))
  (cons element trailer))
----------------------------------------------------------------------------

Only a Few LISP Primitives Are Really Necessary

(defun user-defined-length (l)
  (if (endp l)
      0
      (+ 1 (user-defined-length (rest l))))

(defun user-defined-append2 (l1 l2)
  (if (endp l1)
      l2
      (cons (first l1)
            (user-defined-append2 (rest l1)
                                  l2))))

(defun user-defined-append (&rest lists)
  (append-aux lists))
(defun append-aux (lists)
  (if (endp lists)
      nil
      (user-defined-append2 (first lists)
                            (append-aux (rest lists)))))

題題題題題題題題題題題題題題題題題題題題題題題題題題

5-1: 
(defun skip-first-n (n l)
  (if (zerop n)
      l
      (skip-first-n (- n 1) (rest l))))

5-2: 
(defun keep-first-n (n l)
  (if (zerop n)
      nil
      (cons (first l) (keep-first-n (- n 1) (rest l)))))

5-3: 
(defun keep-first-n-cleverly (l n)
  (keep-first-n-cleverly-aux l n nil))

(defun keep-first-n-cleverly-aux (l n result)
  (if (zerop n)
      (reverse result)
      (keep-first-n-cleverly-aux (rest l)
                                 (- n 1)
                                 (cons (first l) result))))

5-4:
(defun add (x y)
  (if (zerop y)
      x
      (add (1+ x) (1- y))))

Note that ADD would not be tail recursive if the last line were written as 
(1+ (ADD X (1- Y))). Also note that the following solution is more efficient
whenever the value of the second argument is larger than the value of the
first:

(defun add (x y)
  (if (> y x)
      (add y x)
      (if (zerop y)
          x
          (add (1+ x) (1- y)))))

5-5:
(defun tower-of-hanoi (disks)
  (if (endp disks)
      0                                    ;No disks to move.
      (+ (tower-of-hanoi (rest disks))     ;Store all but the bottom disk.
         1                                 ;Move the bottom disk.
         (tower-of-hanoi (rest disks)))))  ;Move the stored disks again.

If there are no disks to move, TOWER-OF-HANOI returns 0 immediately.  
Otherwise, TOWER-OF-HANOI adds three numbers together: the number of moves
to move all but one disk from the source pin to the spare pin; plus one for 
the move of the bottom disk from the source pin to the destination pin;
plus the number of moves to move the temporarily stored disks from the 
spare pin to the destination pin.  Of course the following singly-recursive 
version is much more efficient:

(defun tower-of-hanoi (disks)
  (if (endp disks)
      0
      (+ 1 (* 2 (tower-of-hanoi (rest disks))))))

5-6: MYSTERY computes the depth to which a given expression is nested.
Here is an example:
* (mystery '(((shallow part)) ((((deep part))))))
5

5-7: STRANGE returns a copy of the expression it is given.

5-8: 
(defun presentp (item s)
  (cond ((eql s item) t)
        ((null s) nil)
        ((atom s) nil)
        (t (or (presentp item (first s))
               (presentp item (rest s))))))

Note that the line ((NULL S) NIL) is not really necessary because the
following line, ((ATOM S) NIL) would catch all empty lists anyway.
However, ((NULL S) NIL) is included to make the procedure more transparent.

5-9:
(defun squash (s)
  (cond ((null s) nil)
        ((atom s) (list s))
        (t (append (squash (first s))
                   (squash (rest s))))))

5-10:
(defun fibonacci (n)
  (round (/ (- (expt (/ (+ 1 (sqrt 5)) 2) (+ n 1))
               (expt (/ (- 1 (sqrt 5)) 2) (+ n 1)))
            (expt 5))))

The result of the inner computation is a floating-point number.  We used
ROUND to turn the result into an integer.  Actually, one of the two terms
in the difference is always much smaller than the other and so can be omitted
safely if we are going to perform a rounding operation in the end anyway.
Also, some efficiency could be gained here by computing the square root
of 6 just once using LET to hold on to its value.

5-11:
(defun punctuate (l &optional (mark 'period))
  (append l (list mark)))

5-12:
(defun fibonacci (n &optional
                    (i 1)
                    (previous-month 1)
                    (this-month 1))
  (if (= n 1)                                       ;Terminating condition.
      this-month
      (fibonacci n
                 (+ 1 i)                            ;Counting up until i=n.
                 (this-month
                 (+ this-month previous-month))))
5-13:
(defun tail-recursive-expt (m n &optional (product 1))
  (if (zerop n)
      product
      (tail-recursive-expt m
                           (- n 1)
                           (* m product))))

5-14:
(defun tail-recursive-reverse (l &optional result)
  (if (endp l)
      result
      (tail-recursive-reverse (rest l)
                              (cons (first l) result)))

5-15:
(defun clever-count-atoms (l &optional (count 0))
  (cond ((null l) count)                       ;Return accummlated count.
        ((atom l) (+count 1))                  ;Return count plus one.
        (t (clever-count-atoms
             (rest l)
             (clever-count-atoms (first l) count)))))  ;Count so far.

Note that this procedure is not tail recursive because CLEVER-COUNT-ATOMS
is invoked a second time, after the inner call to CLEVER-COUNT-ATOMS returns.
So (REST L), among other things, has to be remembered while the inner
recursive form is evaluated.  No call to CLEVER-COUNT-ATOMS can just call
itself and die-each needs to call itself a second time using the result
obtained from the first call to itself.

5-16: (defun user-defined-list (&rest l) l)
&rest 把全部 arguments 變成一個表

5-17: 
(defun user-defined-nthcdr (n l)
  (if (zerop n)
      l
      (user-defined-nthcdr (- n l) (rest l))))

5-18:
(defun user-defined-last (l)
  (if (endp (rest l)
      l
      (user-defined-last (rest l))))