chlh_jd
发表于 2010-9-25 23:04:00
本帖最后由 chlh_jd 于 2012-7-8 02:27 编辑
<p>以上10题,伪答案已经陆陆续续都有,大家有没有心得看法——到底什么时候使用递归更高效</p>
<p>(递归不一定是要定义一个递归函数,使用while也可以实现函数内部递归)</p>
<p>欢迎多提些自己的想法</p>
<p>接着这个贴子和大家一起讨论更复杂更高效一点的递归算法(如交叉递归或者说相互嵌套递归或者说结合动态规划的嵌套)在LISP的应用</p>
<p></p>
<p> </p>
<p> </p>
chlh_jd
发表于 2010-9-26 22:31:00
漏了一贴,现在补上
remove-nth,我把qj-chen老师的代码延伸了下,适合矩阵等二维表使用(为嵌套递归做准备)
;;by GSLS(SS)
;;;删除(nth n lst)项,返回新表
;;;如n为列表(i j)则删除i行j列
(defun remove-nth (n lst)
(if (numberp n)
(if (zerop n)
(cdr lst)
(cons
(car lst)
(remove-nth
(1- n)
(cdr lst)
)
)
)
(mapcar (function (lambda (x)
(remove-nth (cadr n) x)
)
)
(remove-nth (car n) lst)
)
)
)
chlh_jd
发表于 2010-9-27 00:32:00
本帖最后由 作者 于 2010-9-27 15:28:39 编辑
下面举个例子来说明下递归效率:
编写一个叫cartesian的函数,
功能:> (cartesian '(1 2 3) '(4 5))((1 . 4) (1 . 5) (2 . 4) (2 . 5) (3 . 4) (3 . 5))
分别采用3种写法
方法1:嵌套递归
;;by GSLS(SS)
;;;要求使用嵌套递归函数完成
(defun stitch (l2 e)
(cond ((null (cadr l2))
(list (cons e (car l2))))
(t (cons (cons e (car l2)) (stitch (cdr l2) e))))
)
(defun cartesian (l1 l2)
(cond ((null (cadr l1))
(stitch l2 (car l1))
)
(t (append (stitch l2 (car l1)) (cartesian (cdr l1) l2)))
)
)
方法二:使用while循环递归
;;;by GSLS(SS)
;;;使用while递归
(defun cartesian0 (l1 l2 / lst a b l3)
(setq lst nil)
(while (setq a (car l1))
(setq l1 (cdr l1)
l3 l2)
(while (setq b (car l3))
(setq l3 (cdr l3))
(setq lst (cons (cons a b) lst))
)
)
(reverse lst)
)
方法三:使用mapcar加临时函数遍历
(defun cartesian1 (l1 l2)
(apply 'append
(mapcar '(lambda (x)
(mapcar '(lambda (y) (cons x y)) l2)
)
l1
)
)
)
测试参数1——'(1 2 3 5 6 7) '(8 9 10) 运行次数10w次,时间结果如下:
_$
函数:CARTESIAN运行100000次测试结果00:00:08:437
函数:CARTESIAN0运行100000次测试结果00:00:04:905
函数:CARTESIAN1运行100000次测试结果00:00:06:983
_$
测试参数2——'(1 2 3 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) '(21 22 23 24 25 26 27 28 29 30) 行次数1w次,时间结果如下:
_$
函数:CARTESIAN运行10000次测试结果00:00:11:405
函数:CARTESIAN0运行10000次测试结果00:00:04:186
函数:CARTESIAN1运行10000次测试结果00:00:03:812
_$
测试参数3——'(1 2 3 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 2021 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40) '(41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60) 行次数1w次,时间结果如下:
_$
函数:CARTESIAN运行10000次测试结果00:01:09:812
函数:CARTESIAN0运行10000次测试结果00:00:16:563
函数:CARTESIAN1运行10000次测试结果00:00:12:937
_$
随着链表长度的增加,由于未申请临时变量的递归耗用大量存储空间也随着增加,而申请了局部变量的递归和顺序遍历效率互有上下,小表时while循环递归更快,大表时mapcar遍历更快。
chlh_jd
发表于 2010-9-27 15:03:00
本帖最后由 作者 于 2010-9-27 15:30:03 编辑
23楼嵌套递归之所以低效,是因为他并不是真正的意义上的交叉嵌套,您可以修改它,使它变得最高效!最近时间比较少,先来一道交叉嵌套递归在矩阵求模中的应用;
编制一个嵌套递归函数deter,用于矩阵求模,您可以编写一个临时函数cofact,cofact必须调用到deter函数,deter函数必须调用到cofact函数
;;m为矩阵列表
;;格式如(setq m '((1 2 3) (2 4 5) (3 5 6)))
;;求矩阵m的模
(defun cofact (m)
;;写出您的代码,要求调用deter和remove-nth函数
)
(defun deter (m)
;;写出您的代码,要求调用cofact函数
)
chlh_jd
发表于 2010-9-27 15:18:00
为了便于比较交叉递归的效率,这里贴出一个粗糙的矩阵求模函数
(defun (a / m*n m n |A| zh_lst zh_lsti i ∑ti i% aij i%_goon ∏aij
si_i)
(setq m*n (get-m&n a)
m (car m*n)
n (cadr m*n)
)
(if (/= m n)
(setq |A| 0)
(progn
(setq n (length a)
zh_lst (get-zh_lst n)
)
(setq i -1
|A| 0
)
(repeat (length zh_lst)
(setq zh_lsti (nth (setq i (1+ i)) zh_lst)
∑ti (get-t zh_lsti)
i% 0
∏aij 1
i%_goon T
)
(while (and i%_goon (<= (1+ i%) n))
(setq aij (get-aij (1+ i%) (nth i% zh_lsti) a))
(if (or (= aij 0) (null aij))
(setq ∏aij 0
i%_goon nil
)
(setq ∏aij (* ∏aij aij)
i% (1+ i%)
)
)
)
(setq si_i (* (expt -1 ∑ti) ∏aij)
|A|(+ |A| si_i)
)
)
)
)
|A|
)
配套函数:
;;获取矩阵的行列数
(defun get-m&n (a / m n)
(setq m (length a)
n 0
)
(foreach b a
(if (> (length b) n)
(setq n (length b))
)
)
(list m n)
)
;;;获取(1~n)列表的所有不重复组合
(defun get-zh_lst (n / get-nIA-lst i lst)
(defun get-nIA-lst (lst / ret midlst)
(setq ret nil)
(foreach a lst
(foreach b lst
(if (/= a b)
(setq ret (cons (list a b) ret))
)
)
)
(repeat (- (length lst) 2)
(setq midlst nil)
(foreach a lst
(foreach b ret
(if (null (member a b))
(setq midlst (cons (cons a b) midlst))
)
)
)
(setq ret midlst)
)
ret
)
(setq i 0
lst nil
)
(repeat n
(setq i (1+ i))
(setq lst (cons i lst))
)
(get-nIA-lst lst)
)
;;
;;;take out the ij-item of a Matrix list
(defun get-aij (i j a / aij)
(nth (1- j) (nth (1- i) a))
)
;;;求某个自然数n排列的逆系数(Inverse coefficient)
(defun get-t (zh_lst / i mid_t end_t)
;;获取某个组合排列中的第i个元素的逆系数
(defun get-ti (i zh_lst / a mid_t i% mid_a)
(setq a (nth (setq i (1- i)) zh_lst))
(setq mid_t 0
i% i
)
(repeat i
(setq mid_a (nth (setq i% (1- i%)) zh_lst))
(if (> mid_a a)
(setq mid_t (1+ mid_t))
)
)
mid_t
)
(setq i 0
mid_t 0
end_t 0
)
(repeat (length zh_lst)
(setq i (1+ i))
(setq mid_t (get-ti i zh_lst))
(setq end_t (+ end_t mid_t))
)
end_t
)
chlh_jd
发表于 2010-10-5 21:24:00
本帖最后由 作者 于 2010-10-12 1:28:37 编辑
gile大师是这样写的(好像应该叫交叉嵌套,并未使用递归;当然您可以修改成递归函数)
;;; gile-cofact (gile)
;;; returns the gile-cofactor associated to ij item of a matrix
;;;
;;; arguments
;;; i = row index (first row = 1)
;;; j = column index (first column = 1)
;;; m = a matrix
(defun gile-cofact (i j m)
(* (gile-determ
(remove-nth (list (1- i) (1- j)) m)
)
(expt -1 (+ i j))
)
)
;;; gile-determ (gile)
;;; returns the determinant of a matrix
;;;求矩阵的模,即行列式结果
;;; argument : a matrix
;;;(gile-determ m) ( m)( m)
;;;
(defun gile-determ (m)
(if (= 2 (length m))
(- (* (caar m) (cadadr m)) (* (caadr m) (cadar m)))
((lambda (r n)
(apply
'+
(mapcar
(function (lambda (x)
(* x
(gile-cofact
1
(setq n (1+ n))
m
)
)
)
)
r
)
)
)
(car m)
0
)
)
)
chlh_jd
发表于 2011-1-21 15:49:24
参考qj-chen老师的表项替换函数二分法,修改了下函数ch-lst,使得大表替换更为高效;;;表项替换,支持2重表,当指定i为list如(3 1)时,替换第3个子表中的第1个元素
;;;lsp较快算法,二分递归法,
;;;written by qj-chen
;;;Edited by GSLS(SS)
(defun ch-lst (new i lst / j len fst mid)
(if (/= (type i) 'list)
(cond
((minusp i)
lst
)
((> i (setq len (length lst)))
lst
)
((> i (/ len 2))
(reverse (ch-lst new (1- (- len i)) (reverse lst)))
)
(t
(append
(progn
(setq fst nil)
(repeat (rem i 4)
(setq fst (cons (car lst) fst)
lst (cdr lst)
)
)
(repeat (/ i 4)
(setq fst (cons (cadddr lst)
(cons (caddr lst)
(cons
(cadr lst)
(cons
(car lst)
fst
)
)
)
)
lst (cddddr lst)
)
)
(reverse fst)
)
(list new)
(cdr lst)
)
)
)
(progn
(setq j (cadr i)
i (car i)
)
(if j
(progn
(setq mid (nth i lst))
(setq mid (ch-lst new j mid))
(ch-lst mid i lst)
)
(ch-lst new i lst)
)
)
)
)
jack093
发表于 2011-1-30 09:53:29
请教楼主,如何建立一棵树?
d:\tree.jpg
chlh_jd
发表于 2011-2-11 18:06:33
本帖最后由 chlh_jd 于 2011-2-11 18:07 编辑
建立一棵树,没有理解;qj-chen老师在立面树很有心得
chlh_jd
发表于 2012-7-8 02:23:09
本帖最后由 chlh_jd 于 2012-7-8 07:36 编辑
再复杂点的递归,经常在复杂问题的动态规划中用到,硬币问题
这里收录下ElpanovEvgeniy硬币换零问题的代码,原文地址http://www.theswamp.org/index.php?topic=39082.msg443766#msg443766;;; **************************************硬币兑换问题****************************************
;;; n ---- 整币面值
;;; l ---- 分币面值表
;;; 返回最少张数找零方案((分币面值 . 分币张数)...)
(defun eea-change (n l / foo f1 f2 f3)
;;by ElpanovEvgeniy
;;from http://www.theswamp.org/index.php?topic=39082.msg443766#msg443766
;;
(defun foo (n l / i)
(cond ((or (not l) (< n 0)) (list 32767 nil))
((< n (car l)) (foo n (cdr l)))
((zerop (rem n (car l)))
(list (setq i (/ n (car l))) (cons (car l) i))
)
((f1 (f2 n (cdr l)) (foo (- n (car l)) l) (car l)))
)
)
(defun f1 (a b c)
(cond ((not a) (f3 n l))
((< (car a) (1+ (car b))) a)
((= (caadr b) c)
(cons (1+ (car b)) (cons (cons c (1+ (cdadr b))) (cddr b)))
)
((cons (1+ (car b)) (cons (cons c 1) (cdr b))))
)
)
;|
(defun f2 (n l / i)
(setq i 0
l (mapcar (function (lambda (a / b c)
(setq bn
n(rem n a)
c(/ b a)
i(+ i c)
)
(cons a c)
)
)
(vl-sort l (function >))
)
)
(if(= n 0)
(cons i l)
)
)|;;|;;only for art by GSLS(SS)
;;Use (f2 n l '(0)) replace (f2 n l)
(defun f2 (n l r / i a b c)
(cond ((or (not l) (minusp n)) nil)
((zerop n)
(cons (car r) (reverse (cdr r)))
)
((f2 (rem n (car l))
(cdr l)
(cons (+ (car r) (/ n (car l)))
(cons (cons (car l) (/ n (car l))) (cdr r))
)
)
)
)
)|;
(defun f2 (n l / i a b c)
;_by GSLS(SS)
(setq i 0)
(while (and (> n 0) l)
(setq a (car l)
l (cdr l)
b (/ n a)
c (cons (cons a b) c)
n (rem n a)
i (+ i b)
)
)
(if (zerop n)
(cons i (reverse c))
)
)(defun f3 (n l / i)
(cond ((or (not l) (< n 0)) (list 32767 nil))
((< n (car l)) (foo n (cdr l)))
((zerop (rem n (car l)))
(list (setq i (/ n (car l))) (cons (car l) i))
)
((f1 (f3 n (cdr l)) (foo (- n (car l)) l) (car l)))
)
)
(foo n l)
)该算法的主要思路,C= {if denom>j, C , min{ C,1+C[j-denom}} ,其中denom为币种
简单比喻成计算最少零钱张数,如下
(defun _coins ( n l );_by Lee Mac
(cond
( (< n 0) 32767)
( (zerop n) 0)
( (null l) 32767)
( (min (_coins n (cdr l)) (1+ (_coins (- n (car l)) l))))
)
)
测试范举(eea-change 32 '(20 10 5 3)) ;>> (5 (20 . 1) (3 . 4))
(eea-change 98 '(20 10 5 2 1)) ;>>(8 (20 . 4) (10 . 1) (5 . 1) (2 . 1) (1 . 1))