lisp应用递归算法10题

chlh_jd

以下题目您只能应用lisp基础表项操作函数：比如car cdr cons list , if cond , + - =等，不能使用length apply mapcar repeat while 等批量操作和循环函数，应用递归算法写出余下部分代码。
题目1:编写等同于nth功能的递归函数

3. (defun my-nth (n lst)
4. ;;写出您的解决代码
5. )

(defun my-nth (n lst) ;;写出您的解决代码 )

题目2:编写一个等同于length功能的递归函数

3. (defun my-length(lst)
4. ;;写出您的解决代码
5. )

(defun my-length(lst) ;;写出您的解决代码 )

题目3:编写一个等同于append的递归函数

3. (defun my-append (p q)
4. ;;写出您的解决代码
5. )

(defun my-append (p q) ;;写出您的解决代码 )

题目4:编写一个remove-nth递归函数，即删除nth对应表项返回新表

3. (defun remove-nth (n lst)
4. ;;写出您的解决代码
5. )

(defun remove-nth (n lst) ;;写出您的解决代码 )

题目5:编写一个递归函数找到第1个大于0的元素

3. ;;;(setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5))
4. (defun first-pos (lst)
5.   ;;写出您的解决代码
6. )

;;;(setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5)) (defun first-pos (lst)   ;;写出您的解决代码 )

题目6:编写一个函数等同于reverse功能的递归函数，这里您可以使用先前编写过的my-append函数

3. (defun my-reverse(lst)
4. ;;写出您的解决代码
5. )

(defun my-reverse(lst) ;;写出您的解决代码 )

题目7：编写一个递归函数，功能：列出表中元素所有组合，返回组合表需按原表先后顺序
如(1 2 3)->((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) nil)

3. (defun powerset (lst)
4. ;;写出您的解决代码
5. )

(defun powerset (lst) ;;写出您的解决代码 )

题目7a：编写一个递归函数，功能同题目7，但返回结果可以是无序的，要求算法用时要比原来减少半

3. (defun faster-powerset(lst)
4. ;;写出您的解决代码
5. )

(defun faster-powerset(lst) ;;写出您的解决代码 )

题目8:编写一个递归函数，判断给出数n是否为素数

3. (defun is-prime(n)
4. ;;写出您的解决代码
5. )

(defun is-prime(n) ;;写出您的解决代码 )

题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ...

3. (defun ch-lst (new i lst)
4. ;;写出您的解决代码
5. )

(defun ch-lst (new i lst) ;;写出您的解决代码 )

题目10:编写一个递归函数，找出表中通过测试函数test的第1组点对；如(1 2 3 4 5 6 7 1) test为=返回(1 . 1)

3. (defun find-matching-pair(test lst)
4. ;;写出您的解决代码
5. )

(defun find-matching-pair(test lst) ;;写出您的解决代码 )

qjchen

hnfsf 发表于 2014-5-4 22:54
出个题目：
数表由很多根pl线的顶点坐标组成的
一条pl线每段的两个坐标一个元素，第1段和第2段有关系，第 ...

对于单根PL线的，可以如此

(setq a (list (list 1 2) (list 2 3) (list 3 4) (list 4 5)))

(mapcar '(lambda (x y) (list x y)) (reverse (cdr (reverse a))) (cdr a))

不过估计我可能不太看得懂题意

guankuiwu

强大的递归

chlh_jd

因为没有逻辑算法专题，就贴在几何算法这里了

Gu_xl

3. (defun my-nth (n lst / tt k)
4.   (setq k -1)
5.   (defun tt (ll)
6.     (setq k (1+ k))
7.     (if (= k n)
8.       (car ll)
9.       (progn
10. (setq ll (cdr ll))
11. (tt ll)
12.       ) ;_ progn
13.     ) ;_ if
14.   ) ;_ defun
15.   (tt lst)
16. )

(defun my-nth (n lst / tt k)   (setq k -1)   (defun tt (ll)     (setq k (1+ k))     (if (= k n)       (car ll)       (progn (setq ll (cdr ll)) (tt ll)       ) ;_ progn     ) ;_ if   ) ;_ defun   (tt lst) )

Gu_xl

3. (defun my-length (lst / k tt)
4.   (setq k 0)
5.   (defun tt(ll)
6.     (if ll
7.       (progn
8. (setq k (1+ k)
9.        ll (cdr ll)
10.        )
11. (tt ll)
12. )
13.       k)
14.    
15.     )
16.     (tt lst)
17.   )

(defun my-length (lst / k tt)   (setq k 0)   (defun tt(ll)     (if ll       (progn (setq k (1+ k)        ll (cdr ll)        ) (tt ll) )       k)         )     (tt lst)   )

chlh_jd

Gu_xl兄，这里不允许使用局部变量,所以不能有k,您可以直接定义局部函数，但不能添加局部变量

Gu_xl

chlh_jd发表于2010-8-29 20:34:00Gu_xl兄，这里不允许使用局部变量,所以不能有k,您可以直接定义局部函数，但不能添加局部变量

呵呵，能不能把要求一下全部说清楚呀，比如说repeat命令可不可以用啊？
先发一个改好的！

3. (defun my-length (lst /  tt)
4.   (defun tt (ll)
5.     (if ll
6.       (progn
7. (setq ll (cdr ll))
8. (1+ (tt ll))
9.       ) ;_ progn
10.       0
11.     ) ;_ if
12.   ) ;_ defun
13.   (tt lst)
14. )

(defun my-length (lst /  tt)   (defun tt (ll)     (if ll       (progn (setq ll (cdr ll)) (1+ (tt ll))       ) ;_ progn       0     ) ;_ if   ) ;_ defun   (tt lst) )

l使用了repeat,算法不是递归算法了！

3. (defun my-nth (n lst / tt k)
4.     (repeat n
5.       
6.     (setq lst (cdr lst))
7.       )
8.   (car lst)
9. )

(defun my-nth (n lst / tt k)     (repeat n            (setq lst (cdr lst))       )   (car lst) )

qjchen

:) 挺有趣的题目

刚出差回来，先上几个，占个位置，慢慢来完成，写的挺不精简的，也没有什么容错，应付某些特殊情况亦会出错，等下次再来缩写

(1) my-nth

4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5. ;;;by qjchen@gmail.com
6. (defun my-nth (n lst)
7. (cond
8.        ((< n 0) nil)
9.        ((= n 0) (car lst))
10.        (T (setq lst (cdr lst) n (1- n) ) (my-nth n lst))
12. )
13. )
14. (setq lst '(1 2 3))
15. (my-nth 2 lst)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;by qjchen@gmail.com (defun my-nth (n lst) (cond        ((< n 0) nil)        ((= n 0) (car lst))        (T (setq lst (cdr lst) n (1- n) ) (my-nth n lst)) ) ) (setq lst '(1 2 3)) (my-nth 2 lst)

(2) my-length

3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4. ;;;by qjchen@gmail.com
5. (defun my-length(lst)
6. (cond
7.        ((= (car lst) nil) 0)
8.        (T (setq lst (cdr lst)) (1+ (my-length lst)))
10. )
11. )
12. (setq lst '(1 2 3))
13. (my-length lst)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;by qjchen@gmail.com (defun my-length(lst) (cond        ((= (car lst) nil) 0)        (T (setq lst (cdr lst)) (1+ (my-length lst))) ) ) (setq lst '(1 2 3)) (my-length lst)

(3) my-append

3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4. ;;;by qjchen@gmail.com
5. (defun my-append (p q)
6.   (cond
7.        ((= (car p) nil) q)
8.        (T (setq q (cons (last p) q) p (reverse (cdr (reverse p))) ) (my-append p q))
10. )
11. )
12. (setq lst '(1 2 3) lst1 '(3 4 5))
13. (my-append lst lst1)
15. ;;;;或者是如下更简单形式
16. (defun my-append(p q)
17. (if p (cons (car p) (my-append1 (cdr p) q))
18.      q
19. )
20. )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;by qjchen@gmail.com (defun my-append (p q)   (cond        ((= (car p) nil) q)        (T (setq q (cons (last p) q) p (reverse (cdr (reverse p))) ) (my-append p q)) ) ) (setq lst '(1 2 3) lst1 '(3 4 5)) (my-append lst lst1) ;;;;或者是如下更简单形式 (defun my-append(p q) (if p (cons (car p) (my-append1 (cdr p) q))      q ) )

(4) remove-nth

3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4. ;;;by qjchen@gmail.com
5. (defun remove-nth(n lst)
6. (cond
7.     ((= n 0) (cdr lst))
8.     ((> n 0) (cons (car lst) (remove-nth (setq n (1- n)) (setq lst (cdr lst)))))
10. )
11. )
12. (setq lst '(1 2 3 4 5))
13. (remove-nth 4 lst)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;by qjchen@gmail.com (defun remove-nth(n lst) (cond     ((= n 0) (cdr lst))     ((> n 0) (cons (car lst) (remove-nth (setq n (1- n)) (setq lst (cdr lst))))) ) ) (setq lst '(1 2 3 4 5)) (remove-nth 4 lst)

(5)编写一个递归函数找到第1个大于0的元素

3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4. ;;;by qjchen@gmail.com
5. (defun first-pos (lst)
6.   (cond
7.     ((> (car lst) 0) (car lst))
8.     (T (first-pos (setq lst (cdr lst))))
9. )
10. )
12. (setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5))
13. (first-pos lst)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;by qjchen@gmail.com (defun first-pos (lst)   (cond     ((> (car lst) 0) (car lst))     (T (first-pos (setq lst (cdr lst)))) ) ) (setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5)) (first-pos lst)

(6)题目6:编写一个函数等同于reverse功能的递归函数，这里您可以使用先前编写过的my-append函数

3. ;;;;题目6:编写一个函数等同于reverse功能的递归函数，这里您可以使用先前编写过的my-append函数
4. (defun my-append1(p q)
5. (if p (cons (car p) (my-append1 (cdr p) q))
6.      q
7. )
8. )
9. (defun my-reverse(lst)
10. (if lst (my-append1 (my-reverse (cdr lst)) (list (car lst))))
11. )
12. (setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5))
13. (my-reverse lst)

;;;;题目6:编写一个函数等同于reverse功能的递归函数，这里您可以使用先前编写过的my-append函数 (defun my-append1(p q) (if p (cons (car p) (my-append1 (cdr p) q))      q ) ) (defun my-reverse(lst) (if lst (my-append1 (my-reverse (cdr lst)) (list (car lst)))) ) (setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5)) (my-reverse lst)

(9) ;;;;;题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ...

3. ;;;;;题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ...
4. (defun ch-lst (new i lst)
5. (cond
6.     ((= i 0) (cons new (cdr lst)))
7.     ((> i 0) (cons (car lst) (ch-lst new (1- i) (cdr lst))))
8.     (T lst)
9. )
10. )
11. (setq lst '(1 2 3 4 5))
12. (ch-lst 8 2 lst)

;;;;;题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ... (defun ch-lst (new i lst) (cond     ((= i 0) (cons new (cdr lst)))     ((> i 0) (cons (car lst) (ch-lst new (1- i) (cdr lst))))     (T lst) ) ) (setq lst '(1 2 3 4 5)) (ch-lst 8 2 lst)

以下几道题是后作的，主要是排列组合花了较多时间，还是没有写的很好，如何顺利输出一个漂亮的列表，大概只靠递归还有点麻烦，加一个排序函数会好些，其中都是加入了一些子函数，如用递归定义了mapcar（说明，并不能完全和lisp的mapcar相同，因为autolisp里面的mapcar可以多个参数，而我定义的mymapcar是不行的，这一点也是我一直比较疑惑的地方，在纯lisp里面，带不定参数的函数，其参量可以用. 来隔开，这个在许多新兴语言，如actionscript里面都可以看到，但autolisp还不行）。

而需要说明的是素数测试，这里面的递归主要体现在find-2，由于用递归法算素数其实很不好，这里也就将就用+1法的递归，勉勉强强来完成了。

以前对递归一直没有很仔细的学习，总是有点依赖心理，这次仔细做了一遍，还是很有收获的，谢谢楼主的题目

其实还有许许多多的lisp递归题目，有空我也放几个上来 :)


(7) 排列组合:此题我的写法还比较土了些，导致结果没有什么规律，但结果应该是全的，速度方面暂时不是很清楚
题目7a：编写一个递归函数，功能同题目7，但返回结果可以是无序的，要求算法用时要比原来减少半

3. ;;;题目7a：编写一个递归函数，功能同题目7，但返回结果可以是无序的，要求算法用时要比原来减少半
4. ;;; by qjchen@gmail.com
5. (defun powerset (lst)
6.   (defun mymapcar(fun lst)
7.      (cond ((not (null lst)) (cons ((eval fun) (car lst)) (mymapcar fun (cdr lst))))
8.            (T nil)
9.      )
10.   )
11.   (defun com2(a lst)
12.     (append lst (com1 a lst))
13.   )
14.   (defun com1(c lst)
15.    (defun mycons(b)
16.     (if (listp b) (if b (cons c b) c) (list c b))
17.    )
18.    (mymapcar 'mycons lst)
19.   )
20.   (cond
21.        ((and (car lst) (not (cdr lst))) (list (car lst) nil))
22.        (T
23.        (com2 (car lst) (powerset (cdr lst))))
24.   )
25. )
27. (powerset '(1 2 3 4 5))

;;;题目7a：编写一个递归函数，功能同题目7，但返回结果可以是无序的，要求算法用时要比原来减少半 ;;; by qjchen@gmail.com (defun powerset (lst)   (defun mymapcar(fun lst)      (cond ((not (null lst)) (cons ((eval fun) (car lst)) (mymapcar fun (cdr lst))))            (T nil)      )   )   (defun com2(a lst)     (append lst (com1 a lst))   )   (defun com1(c lst)    (defun mycons(b)     (if (listp b) (if b (cons c b) c) (list c b))    )    (mymapcar 'mycons lst)   )   (cond        ((and (car lst) (not (cdr lst))) (list (car lst) nil))        (T        (com2 (car lst) (powerset (cdr lst))))   ) ) (powerset '(1 2 3 4 5))

(10) 题目10:编写一个递归函数，找出表中通过测试函数test的第1组点对；如(1 2 3 4 5 6 7 1) test为=返回(1 . 1)

3. ;;;;题目10:编写一个递归函数，找出表中通过测试函数test的第1组点对；如(1 2 3 4 5 6 7 1) test为=返回(1 . 1)
4. ;;;; by qjchen@gmail.com
5. (defun find-matching-pair(lst)
6.   (cond ((find-1 (car lst) (cdr lst)) (find-1 (car lst) (cdr lst)))
7.        ((null lst) nil)
8.        (T (find-matching-pair (cdr lst)))
9.   )
10. )
11. (defun find-1(a lst)
12. (cond ((test a (car lst)) (cons a (car lst)))
13.        ((null lst) nil)
14.        (T (find-1 a (cdr lst)))
15. )
16. )
17. (defun test(a b)
18.   (= a b)
19. )
21. (find-matching-pair (list 2 3 4 5 1 6 5))

;;;;题目10:编写一个递归函数，找出表中通过测试函数test的第1组点对；如(1 2 3 4 5 6 7 1) test为=返回(1 . 1) ;;;; by qjchen@gmail.com (defun find-matching-pair(lst)   (cond ((find-1 (car lst) (cdr lst)) (find-1 (car lst) (cdr lst)))        ((null lst) nil)        (T (find-matching-pair (cdr lst)))   ) ) (defun find-1(a lst) (cond ((test a (car lst)) (cons a (car lst)))        ((null lst) nil)        (T (find-1 a (cdr lst))) ) ) (defun test(a b)   (= a b) ) (find-matching-pair (list 2 3 4 5 1 6 5))

(8) ;;;;题目8:编写一个递归函数，判断给出数n是否为素数

3. ;;;;题目8:编写一个递归函数，判断给出数n是否为素数
4. ;;;by qjchen@gmail.com
5. (defun is-prime(n)
6. (defun smalldivisor (n)
7.   (find-2 n 2))
8. (defun find-2 (n i)
9.   (cond ((> (* i i) n) n)
10.         ((= (rem n i) 0) i)
11.         (T (find-2 n (1+ i)))
12.   )
13. )
14. (cond ((and (= (type n) 'INT) (> n 1)) (= (smalldivisor n) n))
15.        (T nil))
16. )

;;;;题目8:编写一个递归函数，判断给出数n是否为素数 ;;;by qjchen@gmail.com (defun is-prime(n) (defun smalldivisor (n)   (find-2 n 2)) (defun find-2 (n i)   (cond ((> (* i i) n) n)         ((= (rem n i) 0) i)         (T (find-2 n (1+ i)))   ) ) (cond ((and (= (type n) 'INT) (> n 1)) (= (smalldivisor n) n))        (T nil)) )

chlh_jd

QJ-CHEN老师，除了第7、7a、8、10道给出了全部答案了，强悍!

GU_xl兄，这里要求是用递归函数，递归就意味着过程需要调用自身函数。

qjchen

:)

 

勉勉强强都做完了，许多函数可以优化的，等慢慢来改进。

 

排列组合的题目比较有趣，值得深究。谢谢楼主

 

欢迎多出题目，Highflybird兄是算法高手，对于递归，分治等等有深入研究

chlh_jd

因为递归在LISP中实质就是car 与cdr的组合，不使用递归采用while并定义一些局部变量效率相差不多，多次测试结果说明递归在lisp效率一般；比如下面这2个函数：
功能：判断表中元素是否均相同；运行10万次递归函数时间仅略少0.02s左右
(1)使用while

3. ;;;判断表中子项是否均相同
4. ;;;by GSLS(SS)
5. (defun apply-eq (lst / i a mid)
6.     (setq i 0
7.    a (if (cadr lst) T nil)
8.     )
9.     (while (and a (setq mid (nth (1+ i) lst)))
10.       (if (equal mid (nth i lst))
11. nil
12. (setq a nil)
13.       )
14.       (setq i (1+ i))
15.     )
16.     a
17.   )

;;;判断表中子项是否均相同 ;;;by GSLS(SS) (defun apply-eq (lst / i a mid)     (setq i 0    a (if (cadr lst) T nil)     )     (while (and a (setq mid (nth (1+ i) lst)))       (if (equal mid (nth i lst)) nil (setq a nil)       )       (setq i (1+ i))     )     a   )

(2)使用递归

3. ;;;by GSLS(SS)
4. (defun apply-eq (lst)
5.   (if (null lst)
6.     (*error* "No list")
7.     (cond ((null (caddr lst)) (equal (car lst) (cadr lst)))
8.    ((equal (car lst) (cadr lst))
9.     (apply-eq (cdr lst))
10.    )
11.    (t nil)
12.     )
13.   )
14. )

;;;by GSLS(SS) (defun apply-eq (lst)   (if (null lst)     (*error* "No list")     (cond ((null (caddr lst)) (equal (car lst) (cadr lst)))    ((equal (car lst) (cadr lst))     (apply-eq (cdr lst))    )    (t nil)     )   ) )