lisp应用递归算法10题

chlh_jd · 发表于 2010-9-25 23:04:00

本帖最后由 chlh_jd 于 2012-7-8 02:27 编辑

以上10题，伪答案已经陆陆续续都有，大家有没有心得看法——到底什么时候使用递归更高效
（递归不一定是要定义一个递归函数，使用while也可以实现函数内部递归）
欢迎多提些自己的想法
接着这个贴子和大家一起讨论更复杂更高效一点的递归算法（如交叉递归或者说相互嵌套递归或者说结合动态规划的嵌套）在LISP的应用

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 20 21 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 [mo] (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
)

;;获取矩阵的行列数
(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) ([mo] m)([tr] 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)
)
)
)
)

;;;表项替换，支持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 b n
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)
)

;;; **************************************硬币兑换问题**************************************** 
;;; 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 b  n 
              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[j]= {if denom>j , C[i+1][j] , min{ C[i+1][j],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))

复制代码

账号		自动登录	找回密码
密码			注册

lisp应用递归算法10题

本帖子中包含更多资源