把此贴删除

ZZXXQQ

2. (defun c:tt ()
   
3. (setq l1 (list  01 02 03 07 10 12 16 17 19 25 26 28 31 32 33)
   
4. l2 (list 01 02 06 08 10 12 15 16 18 19 25 23 31)
   
5. l3 (list 20 21 22 24 25 27 28 29 30 31 32 33))
   
6. (setq l1 (vl-sort l1 '<) l2 (vl-sort l2 '<) l3 (vl-sort l3 '<))
   
7. (setq start (max (car l1) (car l2) (car l3)))
   
8. (while (< (car l1) start) (setq l1 (cdr l1)))
   
9. (while (< (car l2) start) (setq l2 (cdr l2)))
   
10. (while (< (car l3) start) (setq l3 (cdr l3)))
    
11. (setq lst (list))
    
12. (while (and (> (length l1) 0) (> (length l2) 0) (> (length l3) 0))
    
13.   (while (< (car l1) (car l2)) (setq l1 (cdr l1)))
    
14.   (while (< (car l2) (car l1)) (setq l2 (cdr l2)))
    
15.   (while (< (car l2) (car l3)) (setq l2 (cdr l2)))
    
16.   (while (< (car l3) (car l2)) (setq l3 (cdr l3)))
    
17.   (while (< (car l3) (car l1)) (setq l3 (cdr l3)))
    
18.   (while (< (car l1) (car l3)) (setq l1 (cdr l1)))
    
19.   (if (= (car l1) (car l2) (car l3))
    
20.    (setq lst (cons (car l1) lst) l1 (cdr l1) l2 (cdr l2) l3 (cdr l3))
    
21.   )
    
22. )
    
23. (reverse lst)
    
24. )
    

(defun c:tt ()<br /> (setq l1 (list  01 02 03 07 10 12 16 17 19 25 26 28 31 32 33)<br /> l2 (list 01 02 06 08 10 12 15 16 18 19 25 23 31)<br /> l3 (list 20 21 22 24 25 27 28 29 30 31 32 33))<br /> (setq l1 (vl-sort l1 '<) l2 (vl-sort l2 '<) l3 (vl-sort l3 '<))<br /> (setq start (max (car l1) (car l2) (car l3)))<br /> (while (< (car l1) start) (setq l1 (cdr l1)))<br /> (while (< (car l2) start) (setq l2 (cdr l2)))<br /> (while (< (car l3) start) (setq l3 (cdr l3)))<br /> (setq lst (list))<br /> (while (and (> (length l1) 0) (> (length l2) 0) (> (length l3) 0))<br />   (while (< (car l1) (car l2)) (setq l1 (cdr l1)))<br />   (while (< (car l2) (car l1)) (setq l2 (cdr l2)))<br />   (while (< (car l2) (car l3)) (setq l2 (cdr l2)))<br />   (while (< (car l3) (car l2)) (setq l3 (cdr l3)))<br />   (while (< (car l3) (car l1)) (setq l3 (cdr l3)))<br />   (while (< (car l1) (car l3)) (setq l1 (cdr l1)))<br />   (if (= (car l1) (car l2) (car l3))<br />    (setq lst (cons (car l1) lst) l1 (cdr l1) l2 (cdr l2) l3 (cdr l3))<br />   )<br /> )<br /> (reverse lst)<br /> )<br />

Gu_xl

1. (defun tt (ll / l)
   
2.   (setq l (car ll)
   
3.         ll (cdr ll)
   
4.         )
   
5.   (while ll
   
6.     (setq l (vl-remove-if-not '(lambda (x) (member x (car ll))) l)
   
7.           ll (cdr ll)
   
8.           )
   
9.     )
   
10.   l
    
11.   )
    

(defun tt (ll / l)<br />   (setq l (car ll)<br />         ll (cdr ll)<br />         )<br />   (while ll<br />     (setq l (vl-remove-if-not '(lambda (x) (member x (car ll))) l)<br />           ll (cdr ll)<br />           )<br />     )<br />   l<br />   )<br />

;;测试
(setq l1 (list 01 02 03 07 10 12 16 17 19 25 26 28 31 32 33)
      l2 (list 01 02 06 08 10 12 15 16 18 19 25 23 31)
      l3 (list 20 21 22 24 25 27 28 29 30 31 32 33)
)
(tt (list l1 l2 l3))
返回 '(25 31)

wowan1314

再写。

2. (defun t1 (lst)
   
3.     (setq l1 (car lst) ll (cdr lst))
   
4.     (mapcar
   
5.         '(lambda(a)
   
6.             (mapcar
   
7.                 '(lambda(b)
   
8.                     (if (member b a) nil (setq l1 (vl-remove b l1))
   
9.                     )
   
10.                 )
    
11.                 l1
    
12.             )
    
13.         )
    
14.         ll
    
15.     )
    
16.     L1
    
17. )

(defun t1 (lst) <br />     (setq l1 (car lst) ll (cdr lst))<br />     (mapcar<br />         '(lambda(a)<br />             (mapcar<br />                 '(lambda(b)<br />                     (if (member b a) nil (setq l1 (vl-remove b l1))<br />                     )<br />                 )<br />                 l1<br />             )<br />         )<br />         ll<br />     )<br />     L1<br /> )

居然写了这么多。。。 哎

2. ;(T2 (list l1 l2 l3 l4))
   
3. (defun t2 (lst / l1 l2 l3 ll t1)
   
4.     (defun t1 (lst / lst1 lst2)
   
5.         (setq lst2 lst)
   
6.         (mapcar
   
7.             '(lambda(x)
   
8.                 (setq lst2 (cdr lst2))
   
9.                 (if (member x lst2)
   
10.                     (if (member x lst1) nil (setq lst1 (cons x lst1))
    
11.                     )
    
12.                 )
    
13.             )
    
14.             lst
    
15.         )
    
16.         lst1
    
17.     )
    
18.     (setq l1 (car lst) l2 (cadr lst) l3 (t1 (append l1 l2)) lst (cddr lst))
    
19.     (while (setq ll (car lst))
    
20.         (setq l3 (t1 (append l3 ll)) lst (cdr lst))
    
21.     )
    
22.     l3
    
23. )

;(T2 (list l1 l2 l3 l4)) <br /> (defun t2 (lst / l1 l2 l3 ll t1) <br />     (defun t1 (lst / lst1 lst2)<br />         (setq lst2 lst)<br />         (mapcar<br />             '(lambda(x)<br />                 (setq lst2 (cdr lst2))<br />                 (if (member x lst2)<br />                     (if (member x lst1) nil (setq lst1 (cons x lst1))<br />                     )<br />                 )<br />             )<br />             lst<br />         )<br />         lst1<br />     )<br />     (setq l1 (car lst) l2 (cadr lst) l3 (t1 (append l1 l2)) lst (cddr lst))<br />     (while (setq ll (car lst))<br />         (setq l3 (t1 (append l3 ll)) lst (cdr lst))<br />     )<br />     l3<br /> )

ll_j

来一个递归版本：

1. (defun interl(llst / l1)
   
2.   (if (cdr llst)
   
3.     (progn
   
4.       (setq l1 (car llst)
   
5.             llst (cdr llst)
   
6.       )
   
7.       (vl-remove-if-not '(lambda(x) (member x (interl llst))) l1)
   
8.     )
   
9.     (car llst)
   
10.   )
    
11. )

(defun interl(llst / l1)<br />   (if (cdr llst)<br />     (progn<br />       (setq l1 (car llst)<br />             llst (cdr llst)<br />       )<br />       (vl-remove-if-not '(lambda(x) (member x (interl llst))) l1)<br />     )<br />     (car llst)<br />   )<br /> )

测试：
(setq l1 (list 01 02 03 07 10 12 13 16 17 19 25 26 27 28 31 32 33)
      l2 (list 01 02 06 08 10 12 13 15 16 18 19 25 23 27 31)
      l3 (list 01 07 08 11 13 14 15 19 25 27 29)
      l4 (list 01 05 08 10 13 14 17 18 24 27 33)
)

_$ (interl (list l1 l2 l3 l4))
(1 13 27)
_$

xujinhua

每次上来都有用收获....谢谢