根据表第一项特征分组

snsj

(setq lst '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2))----->'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2))
最近迷恋上了双while循环，欢迎高手参与，做出最高效代码和最短代码

2. ;;;特征表项分组，根据表第一项特征将表分组
   
3. ;;;lst:一个表,如果不是表返回nil
   
4. (defun cathh-lst-tzfz (lst / a kj kjj i)
   
5. (if(listp lst);如果不是表返回nil
   
6. (progn
   
7. (setq a(car lst) kj nil kjj nil i 0)
   
8. (while (/= lst nil)
   
9.   (while (and(/= lst nil)(or(null(equal(car lst)a))(zerop i)))   
   
10.     (setq kj(cons(car lst)kj))
    
11.     (setq lst(cdr lst))
    
12.     (setq i(1+ i))
    
13.     )(setq kjj (cons(reverse kj)kjj)kj nil i 0)
    
14.   )(setq kjj(reverse kjj))
    
15.   )(setq kjj nil);progn  
    
16.   )kjj;if end
    
17.   )

;;;特征表项分组，根据表第一项特征将表分组<br /> ;;;lst:一个表,如果不是表返回nil<br /> (defun cathh-lst-tzfz (lst / a kj kjj i)<br /> (if(listp lst);如果不是表返回nil<br /> (progn<br /> (setq a(car lst) kj nil kjj nil i 0)<br /> (while (/= lst nil)<br />   (while (and(/= lst nil)(or(null(equal(car lst)a))(zerop i)))    <br />     (setq kj(cons(car lst)kj))<br />     (setq lst(cdr lst))<br />     (setq i(1+ i))<br />     )(setq kjj (cons(reverse kj)kjj)kj nil i 0)<br />   )(setq kjj(reverse kjj))<br />   )(setq kjj nil);progn  <br />   )kjj;if end<br />   )

牢固

1. (defun f (l a / b c)
   
2.   (while l
   
3.     (if        (= a (car l))
   
4.       (progn (if b
   
5.                (setq c (cons (reverse b) c)
   
6.                      b nil
   
7.                )
   
8.              )
   
9.              (setq b (cons (car l) b)
   
10.                    l (cdr l)
    
11.              )
    
12.              (while (and l (/= a (car l)))
    
13.                (setq b (cons (car l) b)
    
14.                      l (cdr l)
    
15.                )
    
16.              )
    
17.              (setq c (cons (reverse b) c)
    
18.                    b nil
    
19.              )
    
20.       )
    
21.       (progn (setq b (cons (car l) b)
    
22.                    l (cdr l)
    
23.              )
    
24.       )
    
25.     )
    
26.   )
    
27.   (if b
    
28.     (setq c (cons (reverse b) c)
    
29.           b nil
    
30.     )
    
31.   )
    
32.   (reverse c)
    
33. );;测试 (f '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2)  2) ==>'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2))  
    

(defun f (l a / b c)<br />   (while l<br />     (if        (= a (car l))<br />       (progn (if b<br />                (setq c (cons (reverse b) c)<br />                      b nil<br />                )<br />              )<br />              (setq b (cons (car l) b)<br />                    l (cdr l)<br />              )<br />              (while (and l (/= a (car l)))<br />                (setq b (cons (car l) b)<br />                      l (cdr l)<br />                )<br />              )<br />              (setq c (cons (reverse b) c)<br />                    b nil<br />              )<br />       )<br />       (progn (setq b (cons (car l) b)<br />                    l (cdr l)<br />              )<br />       )<br />     )<br />   )<br />   (if b<br />     (setq c (cons (reverse b) c)<br />           b nil<br />     )<br />   )<br />   (reverse c)<br /> );;测试 (f '(2 1 3 4 5 6 2 7 8 9 2 11 13 14 2)  2) ==>'((2 1 3 4 5 6) (2 7 8 9) (2 11 13 14) (2))  <br />

Lispboy

为什么喜欢双WHILE循环了，用MAPCAR不能解决吗？

Lispboy

楼主，这表的第一特征是什么？ 没太看出来。4个小表是根据什么定的？
哦，看明白了，见到2就开新表吗？

snsj

Lispboy 发表于 2013-6-1 17:09
楼主，这表的第一特征是什么？ 没太看出来。4个小表是根据什么定的？
哦，看明白了，见到2就开新表吗？

是的，见到跟表的的第一项相同的就断开

snsj

Lispboy 发表于 2013-6-1 17:08
为什么喜欢双WHILE循环了，用MAPCAR不能解决吗？

WHILE能碰到设定条件后就会退出，而MAPCAR要对整个表循环一遍

Lispboy

snsj 发表于 2013-6-1 17:28
WHILE能碰到设定条件后就会退出，而MAPCAR要对整个表循环一遍

你不是要效率吗，如果表数据很大的情况下，即使MAPCAR全循环一遍也比双WHILE要快的多的多。

另外，你说的遇到限制退出，是什么限制？ 看你的题目好像没说限制。

Love-Lisp

递归法:

1. (defun f (l)  (defun f1 (l a b)
   
2.     (if l
   
3.       (cond
   
4.         ((= (car l) a)
   
5.          (cons b (f1 (cdr l) a (list a)))
   
6.          )
   
7.         (t (f1 (cdr l) a (append b (list (car l)))))
   
8.         )
   
9.       (if b
   
10.         (list b)
    
11.         )
    
12.       )
    
13.     )
    
14.   (f1 (cdr l) (car l) (list (car l)))
    
15.   )

(defun f (l)  (defun f1 (l a b)<br />     (if l<br />       (cond<br />         ((= (car l) a)<br />          (cons b (f1 (cdr l) a (list a)))<br />          )<br />         (t (f1 (cdr l) a (append b (list (car l)))))<br />         )<br />       (if b<br />         (list b)<br />         )<br />       )<br />     )<br />   (f1 (cdr l) (car l) (list (car l)))<br />   )

Free-Lancer

为什么不用member判断呢？来自: Android客户端

xvjiex

感谢楼主分享！