社区 › 几何算法 › lisp应用递归算法10题

chlh_jd 发表于 2010-8-29 11:57

lisp应用递归算法10题

本帖最后由 作者 于 2010-8-30 22:57:39 编辑

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

(defun my-nth (n lst)
;;写出您的解决代码
)
题目2:编写一个等同于length功能的递归函数

(defun my-length(lst)
;;写出您的解决代码
)
题目3:编写一个等同于append的递归函数

(defun my-append (p q)
;;写出您的解决代码
)
题目4:编写一个remove-nth递归函数，即删除nth对应表项返回新表

(defun remove-nth (n lst)
;;写出您的解决代码
)
题目5:编写一个递归函数找到第1个大于0的元素

;;;(setq lst (list -5 -4 -3 -2 -1 0 1 2 3 4 5))
(defun first-pos (lst)
;;写出您的解决代码
)
题目6:编写一个函数等同于reverse功能的递归函数，这里您可以使用先前编写过的my-append函数

(defun my-reverse(lst)
;;写出您的解决代码
)
题目7：编写一个递归函数，功能：列出表中元素所有组合，返回组合表需按原表先后顺序
如(1 2 3)->((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) nil)

(defun powerset (lst)
;;写出您的解决代码
)
题目7a：编写一个递归函数，功能同题目7，但返回结果可以是无序的，要求算法用时要比原来减少半

(defun faster-powerset(lst)
;;写出您的解决代码
)
题目8:编写一个递归函数，判断给出数n是否为素数

(defun is-prime(n)
;;写出您的解决代码
)
题目9:编写一个递归函数,用新元素new替换表lst中第i项元素，这里i = 0 1 2 3 ...

(defun ch-lst (new i lst)
;;写出您的解决代码
)
题目10:编写一个递归函数，找出表中通过测试函数test的第1组点对；如(1 2 3 4 5 6 7 1) test为=返回(1 . 1)

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

qjchen 发表于 2022-12-2 19:37

本帖最后由 qjchen 于 2022-12-2 19:51 编辑

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 发表于 2022-11-17 20:05

强大的递归

chlh_jd 发表于 2010-8-29 11:59

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

Gu_xl 发表于 2010-8-29 20:09

(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 发表于 2010-8-29 20:18

(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 发表于 2010-8-29 20:34

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

Gu_xl 发表于 2010-8-30 09:54

本帖最后由 作者 于 2010-8-30 10:37:49 编辑

chlh_jd发表于2010-8-29 20:34:00static/image/common/back.gifGu_xl兄，这里不允许使用局部变量,所以不能有k,您可以直接定义局部函数，但不能添加局部变量呵呵，能不能把要求一下全部说清楚呀，比如说repeat命令可不可以用啊？
先发一个改好的！

(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,算法不是递归算法了！

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

qjchen 发表于 2010-8-30 17:57

[原创] 个人的第一个F# JIG代码——截断线绘制

本帖最后由 作者 于 2010-8-31 16:54:43 编辑

:) 挺有趣的题目

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

(1) my-nth


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

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

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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的元素

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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函数



;;;;题目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 ...

;;;;;题目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，但返回结果可以是无序的，要求算法用时要比原来减少半

;;;题目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)

;;;;题目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是否为素数

;;;;题目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 发表于 2010-8-30 22:45

<p>QJ-CHEN老师，除了第7、7a、8、10道给出了全部答案了，强悍!</p>
<p>GU_xl兄，这里要求是用递归函数，递归就意味着过程需要调用自身函数。</p>

qjchen 发表于 2010-8-31 16:58

[原创] 个人的第一个F# JIG代码——截断线绘制

<p>:)</p>
<p>&nbsp;</p>
<p>勉勉强强都做完了，许多函数可以优化的，等慢慢来改进。</p>
<p>&nbsp;</p>
<p>排列组合的题目比较有趣，值得深究。谢谢楼主</p>
<p>&nbsp;</p>
<p>欢迎多出题目，Highflybird兄是算法高手，对于递归，分治等等有深入研究</p>

chlh_jd 发表于 2010-8-31 21:54

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

;;;判断表中子项是否均相同
;;;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)使用递归

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

查看完整版本: lisp应用递归算法10题