表提重复

啵浪鼓

分析lst表中y坐标相同，保留一组移除其它y相同，该如何写函数?
((10 20) (5 40) (10 30) (20 40) (10 40))
因为y坐标40相同，返回
((10 20) (5 40) (10 30))

yoyoho

啵浪鼓 发表于 2024-7-13 21:15
((10 20 2) (20 30 3) (10 20 5) (20 30 1) (20 30 2))
满足x和y坐标相同条件，求xy相同组成一块返回

;|                                                                                                                                                           
满足x和y坐标相同条件，求xy相同组成一块返回                                                                                                                  
(setq qq '((10 20 2) (20 30 3) (10 20 5) (20 30 1) (20 30 2) (10 500 4) (90 500 10) (100 500 400)))                                                   
(reverse (SORT-SAME-XY qq))                                                                                                                           
(((10 20 2) (10 20 5)) ((20 30 3) (20 30 1) (20 30 2)) ((10 500 4)) ((90 500 10)) ((100 500 400)))        
                                                                                                                                                            
|;                                                                                                                                                           
(defun sort-same-xy (l / lst l1 a)                                                                                                                           
   (while l                                                                                                                                                  
     (setq a   (car l)                                                                                                                                       
     l   (cdr l)                                                                                                                                             
           l1  (vl-remove-if '(lambda (e) (or (/= (car e)(car a)) (/= (cadr e)(cadr a))) ) l)                                                               
     lst (cons (cons a l1) lst)                                                                                                                              
     l1 nil                                                                                                                                                  
     l  (vl-remove-if '(lambda (e) (and (= (car e)(car a)) (= (cadr e)(cadr a)) ) ) l)                                                                       
     ))                                                                                                                                                      
  lst)                                                                                                                                                      

jun353835273

2. (defun RemoveY (lst /  y  result dict)  
   
3.   (setq result '())  
   
4.   (setq dict nil)  
   
5.   (foreach pt lst  
   
6.     (setq y (cadr pt))
   
7.     (if (not (assoc y dict))  
   
8.       (progn  
   
9.         (setq result (cons pt result))
   
10.         (setq dict (cons (cons y pt) dict))
    
11.       )  
    
12.     )  
    
13.   )  
    
14.   (reverse result)  
    
15. )

(defun RemoveY (lst /  y  result dict)  <br />   (setq result '())  <br />   (setq dict nil)  <br />   (foreach pt lst  <br />     (setq y (cadr pt)) <br />     (if (not (assoc y dict))  <br />       (progn  <br />         (setq result (cons pt result))<br />         (setq dict (cons (cons y pt) dict)) <br />       )  <br />     )  <br />   )  <br />   (reverse result)  <br /> )

dtucad

凑热闹，来个递归

1. (defun c:tt ()
   
2.         (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
3.         (list-delsamey lst)
   
4. )
   
5. 
   
6. (defun list-delsamey (lst)
   
7.   (if Lst
   
8.                 (cons (car Lst) (list-delsamey (vl-remove-if '(lambda (x) (equal (cadar lst) (cadr x))) (cdr lst))))
   
9.         )
   
10. )

(defun c:tt ()<br />         (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))<br />         (list-delsamey lst)<br /> )<br /> <br /> (defun list-delsamey (lst)<br />   (if Lst <br />                 (cons (car Lst) (list-delsamey (vl-remove-if '(lambda (x) (equal (cadar lst) (cadr x))) (cdr lst))))<br />         )<br /> )

aws

2. (defun c:gg()
   
3.   (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
4.   (setq newlst nil)
   
5.   (while
   
6.     (setq e(car lst))
   
7.     (setq newlst(cons e newlst))
   
8.     (setq lst(vl-remove-if '(lambda(x)(=(cadr x)(cadr e)))lst))
   
9.   )
   
10.   (setq newlst(reverse newlst))
    
11.   (princ newlst)
    
12.   (princ)
    
13. )

(defun c:gg()<br />   (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))<br />   (setq newlst nil)<br />   (while<br />     (setq e(car lst))<br />     (setq newlst(cons e newlst))<br />     (setq lst(vl-remove-if '(lambda(x)(=(cadr x)(cadr e)))lst))<br />   )<br />   (setq newlst(reverse newlst))<br />   (princ newlst)<br />   (princ)<br /> )

MZ_li

大佬云集，收藏了

mahuan1279

一两句代码的事。

自贡黄明儒

1. (SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
2. (SETQ L (MAPCAR '(LAMBDA(X) (IF (MEMBER (CADR X) L) NIL(PROGN (SETQ L (CONS (CADR X) L)) X))) LL))
   
3. (VL-REMOVE NIL L)
   

(SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)))<br /> (SETQ L (MAPCAR '(LAMBDA(X) (IF (MEMBER (CADR X) L) NIL(PROGN (SETQ L (CONS (CADR X) L)) X))) LL))<br /> (VL-REMOVE NIL L)<br />

啵浪鼓

以上测试均OK，感谢╰(*︶`*)╯

lijiao

2. (SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)) l nil)
   
3. (VL-REMOVE-IF-not '(lambda(x) (if (not (member (cadr x) l)) (setq l (cons (cadr x) l)))) ll)

(SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)) l nil)<br /> (VL-REMOVE-IF-not '(lambda(x) (if (not (member (cadr x) l)) (setq l (cons (cadr x) l)))) ll)

帝都划水王

666,好像有点用，之前也想编个类似的