ANSI Common Lisp Practice - My Answers - Chatper - 3

Ok, Go ahead.

1

(a)

(b)

(c)

(d)

2

注：union 在 Common Lisp 中的作用就是求两个集合的并集。但是这有一个前提，即给的两个列表已经满足集合的属性了。具体的操作过程似乎是对第一个 list 中的每一个元素在第二个 list 中查找，如无则标记一下；待第一个 list 的所有元素在第二个 list 中查完以后将所有标记过的元素放入一个 list 中与第二个 list 进行合并。这意味着，如果刚开始给的两个 list 不完全满足集合的属性，则会有重复出现。本题依照这种思路来完成。

(defun new-union (lst1 lst2)
    (let ((tmplst '()))
        (dolist (obj lst2)
            (if (not (member obj lst1))
                (setf tmplst (append tmplst (cons obj '())))
                nil))
        (append lst1 tmplst)))

3

(defun occurrences (lst)
    (let ((tmplst '()))
        (dolist (obj lst)
            (if (assoc obj tmplst)
                (setf tmplst (addcount obj tmplst))
                (setf tmplst (append tmplst (cons (cons obj 1) nil)))))
        (sort tmplst #'(lambda (lst1 lst2) (> (cdr lst1) (cdr lst2))))))

(defun addcount (obj tmplst)
    (let (reslst '())
        (dolist (xobj tmplst)
                (if (equal (car xobj) obj)
                    (setf reslst (append reslst (cons (cons obj (+ (cdr xobj) 1)) nil)))
                    (setf reslst (append reslst (cons xobj '())))))
        reslst))

4

'(a) 不是 atom，'a 才是 atom。而 member 是采用 eql 判断相等，不是用 equal。个人感觉 (remove '(a . 2) '((a . 2) (b . 3))) 达不到效果也是这个原因。

P.S. 后来在读到第四章时发现，这个问题可以添加 关键字参数 :test #'equal 来解决。(英文版 67 页)

5

; iteration
(defun pos+1 (lst)
    (let ((tmplst nil) (n 0))
        (dolist (obj lst)
            (setf tmplst (append tmplst (cons (+ obj n) nil)))
            (setf n (+ n 1)))
        tmplst))

; recursion
(defun pos+2 (lst)
    (wtf lst 0))

(defun wtf (lst n)
    (if (null lst)
        nil
        (cons (+ (car lst) n) (wtf (cdr lst) (+ n 1)))))

; mapcar (In fact, I also use iteration to create a list from 0 to n-1...)
(defun pos+3 (lst)
    (mapcar #'+ lst
        (let ((tmplst nil) (n 0))
            (dolist (obj lst)
                (setf tmplst (append tmplst (cons n nil)))
                (setf n (+ n 1)))
            tmplst)))

6

注：第一个 cons 的改写不太明白怎么做。cons 已经是基本的操作符之一了。另外第三个 list 的改写需要用到后面的函数接受不定参数。根据知识屏蔽原则，先标记上，将来学到那里了再反过头来补上。再，刚开始定义的 cdr-x 和 car-x 均为题中“政府”制定的 cdr 和 car。

(defun cdr-x (lst)
    (car lst))

(defun car-x (lst)
    (cdr lst))

(defun cons-new (obj lst)
    ())

(defun length-new (lst)
    (if (null lst)
        0
        (+ 1 (length-new (car-x lst)))))

(defun member-new (obj lst)
    (if (null lst)
        nil
        (if (eql obj (cdr-x lst))
            lst
            (member-new obj (car-x lst)))))

7

仅仅修改了 n-elts 函数，使之返回一个 dotted list 而不是一个 proper list

; modified version
(defun compress-m (x)
    (if (consp x)
        (compr-m (car x) 1 (cdr x))
        x))

(defun compr-m (elt n lst)
    (if (null lst)
        (list (n-elts-m elt n))
        (let ((next (car lst)))
            (if (eql next elt)
                (compr-m elt (+ n 1) (cdr lst))
                (cons (n-elts-m elt n)
                        (compr-m next 1 (cdr lst)))))))

(defun n-elts-m (elt n)
    (if (> n 1)
        (cons n elt) ; modify here
        elt))

8

(defun showdots (lst)
    (let ((n (length lst)))
        (dolist (obj lst)
            (format t "(~A . " obj))
        (format t "NIL")
        (do ((i 1 (+ i 1)))
            ((> i n) 'nil)
            (format t ")"))))

9

前注：一开始感觉在 3.15 节那个 bfs 算法上改动一下，使当前 node 等于 end 并且 (cdr queue) 为 nil 时再返回 ，这样可以找到 longest path。然而为了避免在环路中无终止，需要再加上两个限制，都是针对 new-paths 函数的：1. 如果当前带入的 node 是 end 的话，就废弃这条路，不再返回；2. 如果非 1 中情况，先把 mapcar 映射得到的列表搞出来，把其中存在重复元素的子列表删去（即环路），再返回给 bfs 函数。

(defun shortest-path (start end net)
    (bfs end (list (list start)) net))

(defun bfs (end queue net)
    (if (null queue)
        nil
        (let ((path (car queue)))
            (let ((node (car path)))
                (if (and (eql node end) (null (cdr queue)))
                    (reverse path)
                    (bfs end
                        (append (cdr queue)
                                (new-paths path node end net))
                                net))))))

(defun new-paths (path node end net)
    (if (equal node end) ; if node = end, abandon it
        nil
        (let ((tmplst (mapcar #'(lambda (n) (cons n path)) (cdr (assoc node net))))
              (reslst nil))
            (dolist (obj tmplst)
                (if (> (no-repeat obj) (length obj)) ; only return the path which has no repeat dots
                    (setf reslst (cons obj reslst))
                    nil))
            reslst)))

(defun no-repeat (lst) ; judge whether there are repeat dots in a path list. if yes, return number less than or equal to length(lst); or return length(lst)+1
    (let ((tmplst nil))
        (do ((i 1 (+ i 1)))
            ((or (member (nth (- i 1) lst) tmplst) (> i (length lst))) i)
            (setf tmplst (cons (nth (- i 1) lst) tmplst)))))

用于测试的网络：1. '((a b c) (b c) (c d) (d b)) 2. '((a b) (b e) (e f c) (c b d f) (f c))
后注：体会到了 lisp 调试的好。直接在 clisp 里边 load 一下，然后直接顶层调用相关函数，就可以调试了，速度很快。