串列组合请教

pop159

请给位大大们帮咱处理下：
( ("A" "01" "1" "2") ("A" "01" "3" "4") ("A" "01" "5" "6") ("B" "01" "1" "2") ("B" "01" "3" "4") ("B" "01" "5" "6") ("C" "01" "1" "2") ("C" "01" "3" "4") ("C" "01" "5" "6") ) 保留前两位相同的字串，后两位重新组合，结果如下：
( ("A" "01" "1 2 3 4") ("B" "01" "1 2 3 4") ("C" "01" "1 2 3 4") )
求解，谢谢。

Gu_xl

1. (setq l        '(("A" "01" "1" "2")
   
2.           ("A" "01" "3" "4")
   
3.           ("A" "01" "5" "6")
   
4.           ("B" "01" "1" "2")
   
5.           ("B" "01" "3" "4")
   
6.           ("B" "01" "5" "6")
   
7.           ("C" "01" "1" "2")
   
8.           ("C" "01" "3" "4")
   
9.           ("C" "01" "5" "6")
   
10.          )
    
11. )
    
12. (defun countitem (l / rtn flag a)
    
13.   (while l
    
14.     (setq a (car l)
    
15.           l (cdr l)
    
16.     )
    
17.     (setq
    
18.       flag (vl-some
    
19.              '(lambda (X)
    
20.                 (if (and (= (car a) (car x)) (= (cadr a) (cadr x)))
    
21.                   (setq rtn (subst (append x (cddr a)) x rtn))
    
22.                 )
    
23.               )
    
24.              rtn
    
25.            )
    
26.     )
    
27.     (if        (not flag)
    
28.       (setq rtn (cons a rtn))
    
29.     )
    
30.   )
    
31.   (setq rtn (reverse rtn))
    
32.   (mapcar '(lambda (x / b)
    
33.              (list (car x)
    
34.                    (cadr x)
    
35.                    (foreach n (cddr x)
    
36.                      (if b
    
37.                        (setq b (strcat b " " n))
    
38.                        (setq b n)
    
39.                      )
    
40.                    )
    
41.              )
    
42.            )
    
43.           rtn
    
44.   )
    
45. )
    

(setq l        '(("A" "01" "1" "2")<br />           ("A" "01" "3" "4")<br />           ("A" "01" "5" "6")<br />           ("B" "01" "1" "2")<br />           ("B" "01" "3" "4")<br />           ("B" "01" "5" "6")<br />           ("C" "01" "1" "2")<br />           ("C" "01" "3" "4")<br />           ("C" "01" "5" "6")<br />          )<br /> )<br /> (defun countitem (l / rtn flag a)<br />   (while l<br />     (setq a (car l)<br />           l (cdr l)<br />     )<br />     (setq<br />       flag (vl-some<br />              '(lambda (X)<br />                 (if (and (= (car a) (car x)) (= (cadr a) (cadr x)))<br />                   (setq rtn (subst (append x (cddr a)) x rtn))<br />                 )<br />               )<br />              rtn<br />            )<br />     )<br />     (if        (not flag)<br />       (setq rtn (cons a rtn))<br />     )<br />   )<br />   (setq rtn (reverse rtn))<br />   (mapcar '(lambda (x / b)<br />              (list (car x)<br />                    (cadr x)<br />                    (foreach n (cddr x)<br />                      (if b<br />                        (setq b (strcat b " " n))<br />                        (setq b n)<br />                      )<br />                    )<br />              )<br />            )<br />           rtn<br />   )<br /> )<br />

pop159

谢谢Gu_xl 版主，帮助咱的速度大大出乎意料，明经正是有你们才会如此精彩。