lisp应用递归算法10题

chlh_jd

公布“伪答案”的时间还没到啊，大家多SHOW点吧

chlh_jd

题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ...
我把QJ-CHEN老师的源码延伸了下，改为支持2重表，方便诸如矩阵列表使用

3. ;;;by GSLS(SS)
4. ;;;(ch-lst 4 '(2 2) '((1 2 3) (2 4 5) (3 5 6)))返回((1 2 3) (2 4 4) (3 5 6))
5. (defun ch-lst (new i lst / j)
6.   (if (null lst)
7.     (*error* "No list")
8.     (if (numberp i)
9.       (cond ((zerop i)
10.       (cons new (cdr lst))
11.      )
12.      ((> i 1)
13.       (cons
14.         (car lst)
15.         (ch-lst   new  (1- i)  (cdr lst))
16.       )
17.      )
18.      (T lst)
19.       )
20.       (progn
21. (setq j (cadr i) ;_这里您可以不定义局部变量j，和重定义i，但效率将较低
22.        i (car i)
23. )
24. (if j
25.    (ch-lst (ch-lst new j (nth i lst)) i lst)
26.    (ch-lst new i lst)
27. )
28.       )
29.     )
30.   )
31. )

;;;by GSLS(SS) ;;;(ch-lst 4 '(2 2) '((1 2 3) (2 4 5) (3 5 6)))返回((1 2 3) (2 4 4) (3 5 6)) (defun ch-lst (new i lst / j)   (if (null lst)     (*error* "No list")     (if (numberp i)       (cond ((zerop i)       (cons new (cdr lst))      )      ((> i 1)       (cons         (car lst)         (ch-lst   new  (1- i)  (cdr lst))       )      )      (T lst)       )       (progn (setq j (cadr i) ;_这里您可以不定义局部变量j，和重定义i，但效率将较低        i (car i) ) (if j    (ch-lst (ch-lst new j (nth i lst)) i lst)    (ch-lst new i lst) )       )     )   ) )

chlh_jd

素数判断，我是这样写的

3. (defun is-prime (n)
4.   (defun is-prime-helper (n try)
5.     (if (= n try)
6.       T
7.       (if (zerop (rem n try))
8. nil
9. (is-prime-helper n (+ try 1))
10.       )
11.     )
12.   )
13.   (is-prime-helper n 2)
14. )

(defun is-prime (n)   (defun is-prime-helper (n try)     (if (= n try)       T       (if (zerop (rem n try)) nil (is-prime-helper n (+ try 1))       )     )   )   (is-prime-helper n 2) )

qjchen

就是说，假如不定义一个其他函数，就is-prime 本身还是无法递归的:)

chlh_jd

同意qj-chen老师的观点，is-prime不定义局部函数，本身是无法递归的

chlh_jd

第7题powerset递归函数我是这样写的

3. ;;;列出表中元素所有可能组合,包括空集,按先后顺序
4. ;;;(powerset (list 1 2 3)) 返回 ((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) nil)
5. (defun powerset (lst)
6.   (if (null lst)
7.     (list nil)
8.     (append ;_这里的append可以采用自定义myappend函数
9.       (mapcar '(lambda (x) ;_这里的mapcar可以采用qj-chen老师写的自定义mymapcar函数,lamda可以采用defun定义局部函数
10.    (cons (car lst) x)
11.         )
12.        (powerset (cdr lst))
13.       )
14.       (powerset (cdr lst))
15.     )
16.   )
17. )

;;;列出表中元素所有可能组合,包括空集,按先后顺序 ;;;(powerset (list 1 2 3)) 返回 ((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) nil) (defun powerset (lst)   (if (null lst)     (list nil)     (append ;_这里的append可以采用自定义myappend函数       (mapcar '(lambda (x) ;_这里的mapcar可以采用qj-chen老师写的自定义mymapcar函数,lamda可以采用defun定义局部函数    (cons (car lst) x)         )        (powerset (cdr lst))       )       (powerset (cdr lst))     )   ) )

chlh_jd

7a这道题目有点难，牵涉到时间测试，这里先提供一个简易时间测试函数(或许您有更好的，权当献丑吧^_^)

3. ;;;小函数测试时间,ti为使用次数,funname为函数名,funarglist为函数funname的参数列表
4. ;;;如(powerset (list 1 2 3))测试100000次运行时间使用代码为
5. ;;;    (times 100000 'powerset (list (list 1 2 3)))
6. (defun times (ti funname funarglist / t1 t2)
7.   (setq t1 (getvar "date"))
8.   (repeat ti
9.     (vl-catch-all-apply
10.       funname
11.       funarglist
12.     )
13.   )
14.   (setq t2 (getvar "date"))
15.   (princ "函数:")
16.   (princ funname)
17.   (princ (strcat "运行" (rtos ti 2 0) "次" ))
18.   (princ "测试结果")
19.   (princ (menucmd (strcat "M=$(edtime,"
20.      (rtos (- t2 t1) 2 16)
21.      ",HH:MM:SS:MSEC)"
22.     )
23.   )
24.   )
25. )

;;;小函数测试时间,ti为使用次数,funname为函数名,funarglist为函数funname的参数列表 ;;;如(powerset (list 1 2 3))测试100000次运行时间使用代码为 ;;;    (times 100000 'powerset (list (list 1 2 3))) (defun times (ti funname funarglist / t1 t2)   (setq t1 (getvar "date"))   (repeat ti     (vl-catch-all-apply       funname       funarglist     )   )   (setq t2 (getvar "date"))   (princ "函数:")   (princ funname)   (princ (strcat "运行" (rtos ti 2 0) "次" ))   (princ "测试结果")   (princ (menucmd (strcat "M=$(edtime,"      (rtos (- t2 t1) 2 16)      ",HH:MM:SS:MSEC)"     )   )   ) )

qjchen

:) 谢谢chlh_jd的组合函数，写的很简洁

chlh_jd

7a编写一个faster-powerset 递归函数，效率比正向排序高一倍；大家测试下列代码，看看有没有更好的写法

3. ;;;by GSLS(SS)
4. ;;;(faster-powerset (list 1 2 3))
5. (defun faster-powerset (lst)
6.   (defun faster-powerset-helper (p lst)
7.     (if (null lst)
8.       p
9.       (faster-powerset-helper
10. (append
11.    (mapcar '(lambda (x)
12.        (cons (car lst) x)
13.      )
14.     p
15.    )
16.    p
17. )
18. (cdr lst)
19.       )
20.     )
21.   )
22.   (faster-powerset-helper (list nil) lst)
23. )

;;;by GSLS(SS) ;;;(faster-powerset (list 1 2 3)) (defun faster-powerset (lst)   (defun faster-powerset-helper (p lst)     (if (null lst)       p       (faster-powerset-helper (append    (mapcar '(lambda (x)        (cons (car lst) x)      )     p    )    p ) (cdr lst)       )     )   )   (faster-powerset-helper (list nil) lst) )

chlh_jd

第10题，find-matching-pair里面用到了适应函数TEST，在递归里面引用函数名一般是不需要加上quote的，有2种写法分别如下：

方法一，使用nth函数

3. ;;;
4. ;;;
5. ;|测试1
6. (find-matching-pair = (list 1 2 3 4 5 7 8 1 2))
7. |;
8. ;|测试2
9. (find-matching-pair
10.   (lambda (a b) (= a (* b 2)))
11.   (list 1 2 3 4 5 7 8 1 2)
12. )|;
13. (defun find-matching-pair (test lst / find-matching-pair-helper)
14.   (defun find-matching-pair-helper (test lst i j)
15.     (if (= i (length lst))
16.       (princ "no matching pair found")
17.       (if (= j (length lst))
18. (find-matching-pair-helper test lst (+ i 1) 0)
19. (if (and (/= i j)
20.    (test (nth i lst)
21.          (nth j lst)
22.    )
23.      )
24.    (cons (nth i lst) (nth j lst))
25.    (find-matching-pair-helper test lst i (+ j 1))
26. )
27.       )
28.     )
29.   )
30.   (find-matching-pair-helper test lst 0 0)
31. )

;;; ;;; ;|测试1 (find-matching-pair = (list 1 2 3 4 5 7 8 1 2)) |; ;|测试2 (find-matching-pair   (lambda (a b) (= a (* b 2)))   (list 1 2 3 4 5 7 8 1 2) )|; (defun find-matching-pair (test lst / find-matching-pair-helper)   (defun find-matching-pair-helper (test lst i j)     (if (= i (length lst))       (princ "no matching pair found")       (if (= j (length lst)) (find-matching-pair-helper test lst (+ i 1) 0) (if (and (/= i j)    (test (nth i lst)          (nth j lst)    )      )    (cons (nth i lst) (nth j lst))    (find-matching-pair-helper test lst i (+ j 1)) )       )     )   )   (find-matching-pair-helper test lst 0 0) )

方法二、使用前面写过的remove-nth

3. (defun find-matching-pair (test lst)
4.   (defun find-matching-pair-helper (test orig left others)
5.     (if (null left)
6.       (princ "no matching pair found")
7.       (if (null others)
8. (if (null (cdr left))
9.    (princ "no matching pair found")
10.    (find-matching-pair-helper
11.      test
12.      orig
13.      (cdr left)
14.      (remove-nth
15.        (- (length orig)
16.    (length (cdr left))
17.        )
18.        orig
19.      )
20.    )
21. )
22. (if (test (car left) (car others))
23.    (cons (car left) (car others))
24.    (find-matching-pair-helper test orig left (cdr others))
25. )
26.       )
27.     )
28.   )
29.   (find-matching-pair-helper test lst lst (cdr lst))
30. )

(defun find-matching-pair (test lst)   (defun find-matching-pair-helper (test orig left others)     (if (null left)       (princ "no matching pair found")       (if (null others) (if (null (cdr left))    (princ "no matching pair found")    (find-matching-pair-helper      test      orig      (cdr left)      (remove-nth        (- (length orig)    (length (cdr left))        )        orig      )    ) ) (if (test (car left) (car others))    (cons (car left) (car others))    (find-matching-pair-helper test orig left (cdr others)) )       )     )   )   (find-matching-pair-helper test lst lst (cdr lst)) )