Common Lisp学习笔记（八）

8 Recursion

(defun fact (n)
  (cond ((zerop n) 1)
         (t (* n (fact (- n 1))))))

ex 8.4

(defun laugh (n)
  (cond ((zerop n) nil)
         (t (cons 'ha (laugh (- n 1))))))

ex 8.7

(defun rec-member (entry list)
  (cond ((equal entry (first list)) list)
        (t (rec-member entry (rest list)))))

8.11 recursive templates

double-test tail recursion

(defun func (x)
  (end-test-1 end-value-1)
  (end-test-2 end-value-2)
  (t (func reduced-x)))

single-test tail recursion

(defun func (x)
  (cond (end-test end-value)
        (t (func reduced-x))))

ex 8.27

(defun square-list (list)
  (cond ((null list) nil)
         (t (cons (* (first list) (first list)) (square-list (rest list))))))

ex 8.32

(defun sum-numeric-elements (list)
  (cond ((null list) 0)
        ((numberp (first list)) (+ (first list) (sum-numeric-elements (rest list))))
        (t (sum-numeric-elements (rest list)))))

augmenting recursion

(DEFUN func (x)
  (COND (end-test end-value)
  (T (aug-fun aug-val (func reduced-x)))))

eg,
(defun count-slices (x)
  (cond ((null x) 0)
  (t (+ 1 (count-slices (rest x))))))

8.12 variations on the basic templates

consing

(DEFUN func (N)
  (COND (end-test NIL)
  (T (CONS new-element (func reduced-n)))))

多个变量同时变化

(DEFUN func (N X)
  (COND (end-test end-value)
  (T (func reduced-n reduced-x))))

conditional augmentation

(DEFUN func (X)
  (COND (end-test end-value)
  (aug-test (aug-fun aug-val (func reduced-x))
  (T (func reduced-x))))

eg,
(defun extract-symbols (x)
  (cond ((null x) nil)
  ((symbolp (first x)) (cons (first x) (extract-symbols (rest x))))
  (t (extract-symbols (rest x)))))

multiple recursion, 以fabonacci为代表

(DEFUN func (N)
  (COND (end-test-1 end-value-1)
        (end-test-2 end-value-2)
        (T (combiner (func first-reduced-n) (func second-reduced-n)))))

8.13 trees and car/cdr recursion

(defun func (x)
  (cond (end-test-1 end-value-1)
        (end-test-2 end-value-2)
        (t (combiner (func (car x))
                     (func (cdr x))))))

eg,
(defun find-number (x)
  (cond ((numberp x) x)
        ((atom x) nil)
        (t (or (find-number (car x))
               (find-number (cdr x))))))

ex 8.39

(defun count-cons (tree)
  (cond ((null tree) 1)
        ((atom tree) 1)
        (t (+ (count-cons (car tree)) (count-cons (cdr tree))))))

ex 8.43

(defun flatten (x)
  (cond ((null x) nil)
        ((atom x) (list x))
        (t (append (flatten (car x)) (flatten (cdr x))))))

ex 8.44

(defun tree-depth (x)
  (cond ((null x) 0)
        ((atom x) 0)
        ((setf a (tree-depth (car x)))
         (setf b (tree-depth (cdr x)))
         (cond ((> a b) (+ 1 a))
               (t (+ 1 b))))))

8.14 helping functions

eg,
(defun count-up (n)
  (count-up-recursively 1 n))

(defun count-up-recursively (cnt n)
  (cond ((> cnt n) nil)
        (t (cons cnt (count-up-recursively (+ cnt 1) n)))))

ex 8.60

(setf family
  '((colin nil nil)
    (deirdre nil nil)
    (arthur nil nil)
    (kate nil nil)
    (frank nil nil)
    (linda nil nil)
    (suzanne colin deirdre)
    (bruce arthur kate)
    (charles arthur kate)
    (david arthur kate)
    (ellen arthur kate)
    (george frank linda)
    (hillary frank linda)
    (andre nil nil)
    (tamara bruce suzanne)
    (vincent bruce suzanne)
    (wanda nil nil)
    (ivan george ellen)
    (julie george ellen)
    (marie george ellen)
    (nigel andre hillary)
    (frederick nil tamara)
    (zelda vincent wanda)
    (joshua ivan wanda)
    (quentin nil nil)
    (robert quentin julie)
    (olivia nigel marie)
    (peter nigel marie)
    (erica nil nil)
    (yvette robert zelda)
    (diane peter erica)))

(defun father (x)
  (second (assoc x family)))

(defun mother (x)
  (third (assoc x family)))

(defun parents (x)
  (remove-if #'null (rest (assoc x family))))

(defun children (x)
  (cond ((null x) nil) 
        (t (remove-if-not #'(lambda (entry) (member x (parents entry))) (mapcar #'first family)))))

(defun siblings (x)
  (set-difference (union (children (father x)) (children (mother x))) (list x)))

(defun mapunion (func list)
  (reduce #'union (mapcar func list))) 

(defun grandparents (x)
  (cond ((null (parents x)) nil)
        (t (mapunion #'parents (parents x)))))

(defun cousins (x)
  (mapunion #'children (mapunion #'siblings (parents x))))

(defun descended-from (x y)
  (cond ((null (parents x)) nil)
        ((member y (parents x)) t)
        (t (or (descended-from (father x) y)
               (descended-from (mother x) y)))))

(defun ancestors (x)
  (cond ((null (parents x)) nil)
         (t (union (parents x) (mapunion #'ancestors (parents x))))))

(defun generation-gap (x y)
  (cond ((not (descended-from x y)) nil)
        ((member y (parents x)) 1)
        (y (+ 1 (or (generation-gap (father x) y)
            (generation-gap (mother x) y))))))

8.16 tail recursion

为了提高速度，可以将不是尾部递归的函数改为尾部递归，eg,

;;;version 1
(defun count-slices (x)
  (cond ((null x) 0)
  (t (+ 1 (count-slices (rest x))))))

;;;version 2
(defun tr-count-slices (loaf)
  (tr-cs1 loaf 0)

(defun tr-cs1 (loaf n)
  (cond ((null loaf) n)
         (t (tr-cs1 (rest loaf) (+ n 1)))))

第一个不是尾递归，因为函数在最后调用本身之后还要进行加1的操作，增加一个变量n来进行计数之后，可以将加1的工作提前到调用函数之前，所以变成尾递归

再看一个reverse函数

;;;version 1
(defun my-reverse (x)
  (cond ((null x) nil)
         (t (append (reverse (rest x)) (list (first x))))))

;;;version 2
(defun tr-reverse (x)
  (tr-rev1 x nil))

(defun tr-rev1 (x result)
  (cond ((null x) result)
         (t (tr-rev1 (rest x) (cons (first x) result)))))

不是所有函数都能改写成尾部递归，如multiple recursive的函数就不能

ex 8.61

> (count-up 5)
(1 2 3 4 5)

;;;version 1
(defun count-up (n)
  (count-up-recursively 1 n))

(defun count-up-recursively (cnt n)
  (cond ((> cnt n) nil)
        (t (cons cnt (count-up-recursively (+ cnt 1) n)))))

;;;version 2, tail recursion
(defun count-up (n)
  (recursive-count-up n nil))

(defun recursive-count-up (n result)
  (cond ((zerop n) result)
         (t (recursive-count-up (- n 1) (cons n result)))))

ex 8.62

(defun fact (n)
  (recursive-fact n 1))

(defun recursive-fact (n result)
  (cond ((< n 2) result)
         (t (recursive-fact (- n 1) (* n result)))))

8.18 labels

前面的递归函数需要的辅助函数都是用defun在其他地方定义的，这样的缺陷一个是可能错误调用到辅助函数，还有就是辅助函数由于是单独定义的所以不能访问主要函数的局部变量。一种解决的方法是使用labels函数

(labels ((fn1 args1 body1)
         ...
         (fnn argsn bodyn))
    body)

body即函数主题可以调用任意的局部函数，局部函数也可以调用其他的局部函数，或者主函数的局部变量

(defun count-up (n)
  (labels ((count-up-recursively (cnt)
             (if (> cnt n) nil (cons cnt (count-up-recursively (+ cnt 1))))))
  (count-up-recursively 1)))

ex 8.66 先做简单定义，算术表达式，要不就是一个简单的数，要不就是一个三元list,其中第一个和第三个元素也是算术表达式，第二个元素是+,-,*或者/

(defun arith-eval (x)
  (cond ((numberp x) x)
         (t (funcall (second x) (arith-eval (first x)) (arith-eval (third x))))))

ex 8.67

(defun legalp (x)
  (cond ((numberp x) t)
         ((not (equal (length x) 3)) nil)
         ((not (member (second x) '(+ - * /))) nil)
         (t (and (legalp (first x)) (legalp (third x))))))

转载于:https://www.cnblogs.com/jolin123/p/4491566.html