ANSI Common Lisp 第六章习题解

1. Define a version of tokens (page 67) that takes :test and :start

arguments defaulting to #'constituent and 0 respectively.

(defun tokens (str &key (test #'constituent) (start 0))
  (if (not (null str))
      (let ((p0 (position-if test str :start start)))
        (if (not (null p0))
            (let ((p1 (position-if #'(lambda (x)
                                       (not (funcall test x)))
                                   str
                                   :start p0)))
              (if (null p1)
                  (subseq str p0)
                (cons (subseq str p0 p1)
                      (tokens str :test test :start p1))))))))

(defun constituent (x)
  (and (graphic-char-p x)
       (not (eql x #\ ))))

(tokens "  hello world nice  ")

2.Define a version of bin-search (page 60) that takes :key, :test,
:start, and :end arguments with the usual meanings and defaults.

(defun bin-search (obj vec &key (start end test)
  (if (>= end start)
      (let ((mid (truncate (/ (+ start end) 2))))
        (cond ((= obj (aref vec mid)) mid)
              ((> obj (aref vec mid))
               (bin-search obj vec (1+ mid) end test))
              ((< obj (aref vec mid))
               (bin-search obj vec start (1- mid) test))))))

(defparameter *arr* (make-array 5 :initial-element 0))
(setf (aref *arr* 0) 1)
(setf (aref *arr* 1) 4)
(setf (aref *arr* 2) 5)
(setf (aref *arr* 3) 7)
(setf (aref *arr* 4) 8)

3.Define a function that takes any number of arguments and returns the
 number of arguments passed to it 

(defun count-argc (&rest rest)
  (length rest))
(count-argc 1 2 3 4 5)

4. Modify most (page 105) to return, as two values, the two highest-
 scoring elements of a list.

(defun sort2 (o0 o1 fn)
  (if (> (funcall fn o0) (funcall fn o1))
      (values o0 o1)
    (values o1 o0)))
(defun my-most (fn lst)
  (multiple-value-bind
   (o0 o1) (sort2 (car lst) (cadr lst) fn)
   (mapcar #'(lambda (elt)
               (cond ((> (funcall fn elt) (funcall fn o0))
                      (progn (setf o1 o0)
                             (setf o0 elt)))
                     ((> (funcall fn elt) (funcall fn o1))
                      (setf o1 elt))))
           (cddr lst))
   (values o0 o1)))
(my-most #'(lambda (x) x) '(1 3 6 3 7 4 5))

5.Define remove-if (no keywords) in terms of filter (page 105).

(defun filter (fn lst)
  (let ((v nil))
    (mapcar #'(lambda (elt)
                (if (funcall fn elt)
                    (push elt v)))
            lst)
    (nreverse v)))
(defun our-remove-if (fn lst)
  (filter #'(lambda (elt)
              (not (funcall fn elt)))
          lst))
(our-remove-if #'(lambda (x)
                   (oddp x))
               '(1 2 3 4 5))
(filter #'(lambda (x)
            (oddp x))
        '(1 2 3 4 5))

6.Define a function that takes one argument, a number, and returns the
 greatest argument passed to it so far.

(defun make-clo (init-elt)
  #'(lambda (elt)
      (progn (if (or (null init-elt)
                     (> elt init-elt))
                 (setq init-elt elt))
             init-elt)))
(let ((fn (make-clo nil)))
  (defun max-so-far (x)
    (funcall fn x)))
(max-so-far 2)
(max-so-far 3)
(max-so-far 1)

7. Define a function that takes one argument, a number, and returns 
true if it is greater than the argument passed to the function the 
last time it was called. The function should return nil the first 
time it is called.

(defun make-great (init-elt)
  #'(lambda (x)
      (if (null init-elt)
          (progn (setf init-elt x)
                 nil)
        (if (> x init-elt)
            (progn (setf init-elt x)
                   t)
          nil))))

(let ((fn (make-great nil)))
  (defun greeter-so-far? (x)
    (funcall fn x)))
(greeter-so-far? 1)
(greeter-so-far? 2)
(greeter-so-far? 1)
(greeter-so-far? 3)

8. Suppose expensive is a function of one argument, an integer between
0 and 100 inclusive, that returns the result of a time-consuming com-
putation. Define a function frugal that returns the same answer, but
only calls expensive when given an argument it has not seen before.

(defun expensive (x)
  (format t "~A ~%" x)
  x)
(let ((memo (make-hash-table)))
  (defun frugal (x)
    (if (null (gethash x memo))
        (let ((val (expensive x)))
          (setf (gethash x memo) val)
          val)
      (gethash x memo))))
(frugal 1)
(frugal 2)
(frugal 3)

9. Define a function like apply, but where any number printed out before
 it returns will be printed, by default, in octal (base 8).

(defun our-apply (fn args)
  (progn (mapcar #'(lambda (x)
                     (if (numberp x)
                         (format t "0~8R " x)))
                 args)
         (apply fn args)))
(our-apply #'(lambda (&rest x) x) '(11 22 33 44))