啵浪鼓 发表于 2024-7-2 20:27:07

表提重复

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

yoyoho 发表于 2024-7-15 16:35:44

本帖最后由 yoyoho 于 2024-7-15 19:21 编辑

啵浪鼓 发表于 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 发表于 2024-7-2 21:51:45

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

dtucad 发表于 2024-7-2 22:35:05

凑热闹，来个递归
(defun c:tt ()
        (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))
        (list-delsamey lst)
)

(defun list-delsamey (lst)
(if Lst
                (cons (car Lst) (list-delsamey (vl-remove-if '(lambda (x) (equal (cadar lst) (cadr x))) (cdr lst))))
        )
)

aws 发表于 2024-7-2 21:48:12

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

MZ_li 发表于 2024-7-2 22:44:52

大佬云集，收藏了

mahuan1279 发表于 2024-7-2 22:45:01

一两句代码的事。

自贡黄明儒 发表于 2024-7-3 07:35:45

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

啵浪鼓 发表于 2024-7-3 08:29:29

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

lijiao 发表于 2024-7-3 09:14:23

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

帝都划水王 发表于 2024-7-3 09:15:39

666,好像有点用，之前也想编个类似的
页: [1] 2
查看完整版本: 表提重复