写一个小函数

bskidtf

前几天，在院长群里看到院长说的一个问题，挺感兴趣，今天尝试写了一下，分享出来。
院长说的是
(aaa '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5")))))))
→
'(("9" "7" "3" "1")
("9" "7" "3" "2")
("9" "7" "6" "4")
("9" "7" "6" "5")
("9" "8" "3" "1")
("9" "8" "3" "2")
("9" "8" "6" "4")
("9" "8" "6" "5")
)

代码如下

2. (defun LY:SplitBran(Var / first ret second second_1)
   
3. (cond
   
4. ((= (type Var) 'LIST)
   
5. (setq first (car Var));第一个元素
   
6. (if (= (type first) 'STR)
   
7. (progn
   
8. (setq second (cadr Var))
   
9. (cond
   
10. ((= (type second) 'list);第二个元素是表
    
11. (progn
    
12. (setq second_1
    
13. (vl-remove nil (mapcar '(lambda (x)
    
14. (cond
    
15. ( (= (type x) 'STR)
    
16. x
    
17. )
    
18. ((= (type x) 'list)
    
19. (LY:SplitBran x)
    
20. )
    
21. (t
    
22. nil
    
23. )
    
24. )
    
25. )
    
26. second
    
27. )
    
28. )
    
29. );去除nil
    
30. (setq second_1 (append second_1))
    
31. (setq Ret '())
    
32. (foreach X second_1
    
33. (if (= (type X) 'list)
    
34. (foreach Y X
    
35. (setq Ret (cons Y Ret))
    
36. )
    
37. (setq Ret (cons (list X) Ret))
    
38. )
    
39. )
    
40. (reverse (mapcar '(lambda (x)(cons first X)) Ret))
    
41. )
    
42. )
    
43. ((= (type second) 'STR);第二个元素是字符
    
44. ;直接原样返回
    
45. (cdr Var)
    
46. )
    
47. (t;其他情况
    
48. nil
    
49. )
    
50. )
    
51. )
    
52. (;第一个元素不是字符，就返回nil
    
53. nil
    
54. )
    
55. )
    
56. )
    
57. (t ;如果不是表，就返回nil
    
58. nil
    
59. )
    
60. )
    
61. )
    
62. 
    
63. (defun c:tt ()
    
64. (setq var '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5")))))))
    
65. 
    
66. (LY:SplitBran var)
    
67. )
    

(defun LY:SplitBran(Var / first ret second second_1)<br /> (cond<br /> ((= (type Var) 'LIST)<br /> (setq first (car Var));第一个元素<br /> (if (= (type first) 'STR)<br /> (progn<br /> (setq second (cadr Var))<br /> (cond<br /> ((= (type second) 'list);第二个元素是表<br /> (progn<br /> (setq second_1<br /> (vl-remove nil (mapcar '(lambda (x)<br /> (cond<br /> ( (= (type x) 'STR)<br /> x<br /> )<br /> ((= (type x) 'list)<br /> (LY:SplitBran x)<br /> )<br /> (t<br /> nil<br /> )<br /> )<br /> ) <br /> second <br /> )<br /> ) <br /> );去除nil<br /> (setq second_1 (append second_1))<br /> (setq Ret '())<br /> (foreach X second_1 <br /> (if (= (type X) 'list)<br /> (foreach Y X<br /> (setq Ret (cons Y Ret))<br /> )<br /> (setq Ret (cons (list X) Ret))<br /> ) <br /> ) <br /> (reverse (mapcar '(lambda (x)(cons first X)) Ret)) <br /> )<br /> )<br /> ((= (type second) 'STR);第二个元素是字符<br /> ;直接原样返回<br /> (cdr Var)<br /> )<br /> (t;其他情况<br /> nil<br /> )<br /> ) <br /> )<br /> (;第一个元素不是字符，就返回nil <br /> nil<br /> )<br /> )<br /> )<br /> (t ;如果不是表，就返回nil<br /> nil<br /> )<br /> )<br /> )<br /> <br /> (defun c:tt ()<br /> (setq var '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5")))))))<br /> <br /> (LY:SplitBran var)<br /> )<br />

bskidtf

晚上在群里有大佬搞出来一个递归，几行代码就搞定了。太厉害了。

2. (defun tt (a)
   
3. (cond ((atom (cadr a)) (mapcar 'list a))
   
4. ((atom (car a))
   
5. (mapcar '(lambda (x) (cons (car a) x)) (tt (cadr a))))
   
6. (t (apply 'append (mapcar '(lambda (x) (tt x)) a)))))

(defun tt (a)<br /> (cond ((atom (cadr a)) (mapcar 'list a))<br /> ((atom (car a))<br /> (mapcar '(lambda (x) (cons (car a) x)) (tt (cadr a))))<br /> (t (apply 'append (mapcar '(lambda (x) (tt x)) a)))))

1. 
   
2. <P> </P>

复制代码

llsheng_73

看着简单,搞起来比较烧脑

1. (defun SplitBran(lst / LLS_SplitBran)
   
2.   (princ"By:llsheng_73")
   
3.   (defun LLS_SplitBran(l / a)
   
4.     (while(not(listp(car l)))
   
5.       (setq a(cons(car l)a)l(cdr l)))
   
6.     (setq a(reverse a))
   
7.     (mapcar(function(lambda(x)(append a x)))(car l)))
   
8.   (while(and(listp(last lst))(listp(last(last lst)))(listp(last(last(last lst)))))
   
9.     (or(listp(car lst))(setq lst(LLS_SplitBran lst)))
   
10.     (foreach x lst
    
11.       (setq lst(subst(if(and(listp x)(listp(last x))(listp(last(last x))))
    
12.                        (LLS_SplitBran x)(list x))x lst)))
    
13.     (setq lst(apply(function append)lst)))
    
14.   (apply(function append)
    
15.         (mapcar(function(lambda(x / a)
    
16.                           (if(listp(last x))
    
17.                             (progn(setq a(vl-remove(last x)x))
    
18.                               (mapcar(function(lambda(x)(append a(list x))))(last x)))(list x))))lst)))

(defun SplitBran(lst / LLS_SplitBran)<br />   (princ"By:llsheng_73")<br />   (defun LLS_SplitBran(l / a)<br />     (while(not(listp(car l)))<br />       (setq a(cons(car l)a)l(cdr l)))<br />     (setq a(reverse a))<br />     (mapcar(function(lambda(x)(append a x)))(car l)))<br />   (while(and(listp(last lst))(listp(last(last lst)))(listp(last(last(last lst)))))<br />     (or(listp(car lst))(setq lst(LLS_SplitBran lst)))<br />     (foreach x lst<br />       (setq lst(subst(if(and(listp x)(listp(last x))(listp(last(last x))))<br />                        (LLS_SplitBran x)(list x))x lst)))<br />     (setq lst(apply(function append)lst)))<br />   (apply(function append)<br />         (mapcar(function(lambda(x / a)<br />                           (if(listp(last x))<br />                             (progn(setq a(vl-remove(last x)x))<br />                               (mapcar(function(lambda(x)(append a(list x))))(last x)))(list x))))lst)))

(SplitBran'("10"(("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5" "A")))))))))
=>'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1") ("10" "9" "8" "3" "2") ("10" "9" "8" "6" "4") ("10" "9" "8" "6" "5") ("10" "9" "8" "6" "A"))
(SPLITBRAN '("10"(("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" (("1" "2"))) ("6" (("4" "B")("5" "A"))))))))))
=>'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1" "2") ("10" "9" "8" "6" "4" "B") ("10" "9" "8" "6" "5" "A"))

还存在BUG,后边三项都错了，正确的应该是
'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1") ("10" "9" "8" "3" "1") ("10" "9" "8" "6" "4") ("10" "9" "8" "6" "B") ("10" "9" "8" "6" "5") ("10" "9" "8" "6" "A"))


改天再收拾

树櫴希德

看到都头疼

你有种再说一遍

居然在玩数组扁平化,只是lisp太麻烦了

dcl1214

为啥会搞出这样的数据来？

liuhe

bskidtf 发表于 2024-5-21 00:32
晚上在群里有大佬搞出来一个递归，几行代码就搞定了。太厉害了。

我研究了半天，就是写不出来如此精妙的代码啊，大佬牛逼

paulpipi

向大佬致敬，我是看不懂

PDCA2025

日拱一卒，学习了。