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))))))

Common Lisp学习笔记（八）

标签：

原文地址：http://www.cnblogs.com/jolin123/p/4491566.html