社区 › 源码共享 › 点表去除重复和nil项

尘缘一生 发表于 2025-9-19 11:23:26

点表去除重复和nil项

本帖最后由 尘缘一生 于 2025-9-19 19:38 编辑

这个问题很重要，代码虽多，哪个是最高效的？难以准确把握，

整理一个函数，测试还行，但是总感觉还值得推敲，对于排序部分，值得研究，期待高手进一步完善，关键是提速！
;(点表)->删除重复和nil的项 (不支持表中表)----(一级)-----
;fuzz 误差值或nil -->返回点表
(defun dup:pnts (pl fuzz / l n i p)
(if (not fuzz) (setq fuzz 0.01))
(setq i 0 n (length pl))
(while (< i n)
    (if (setq p (car pl)) (setq l (cons (list p i) l)))
    (setq pl (cdr pl) i (1+ i))
)
(setq l (vl-sort l
            '(lambda (a b)
               (if (equal (caar a) (caar b) fuzz)
               (< (cadar a) (cadar b))
               (cond
                   ((< (caar a) (caar b)) t)
                   ((and (= (caar a) (caar b)) (< (cadar a) (cadar b))) t)
                   ((and (= (caar a) (caar b)) (= (cadar a) (cadar b)) (< (caddar a) (caddar b))) t)
               )
               )
             )
          )
)
(while l
    (setq pl (cons (setq n (car l)) pl) l (cdr l))
    (while (and l (equal (car n) (caar l) fuzz))
      (setq l (cdr l))
    )
)
(mapcar 'car (vl-sort pl '(lambda (a b) (< (cadr a) (cadr b)))))
)
;;测试-------------
(defun c:tt0 (/ a l)
(setq a '((48099.6 11160.5 0.0) nil (48098.2 11161.9 0.0) (48116.7 11151.4 0.0) nil (48099.6 11160.5 0.0) nil (48098.2 11161.9 0.0) (48116.7 11151.4 0.0) nil))
(setq l (dup:pnts a 0.01))
l
)
下面的函数比较通用，但是对点表处理，速度慢，也发上来探讨

;删除表中重复和nil的项目(不支持表中表)----(一级)-----
;;(gps->lst-delsame '(1 nil 2 1 2 (1 1) nil (1 2 1 2 1) 1 2 (1 1) (1 2)))->(1 2 (1 1) (1 2 1 2 1) (1 2))
(defun gps->lst-delsame (lst / n i s-car new)
(setq n (length lst) i 0)
(while (< i n)
    (setq s-car (car lst))
    (if (and s-car (not (vl-position s-car new)))
      (setq new (cons s-car new))
    )
    (setq lst (cdr lst) i (1+ i))
)
(reverse new)
)

菜鸟初来乍到 发表于 2025-9-19 13:32:53

感谢大佬的分享

moshouhot 发表于 2025-9-19 15:31:29

;; 辅助函数：一个“通用”的比较函数，用于 vl-sort
;; 能比较数字、字符串、列表等不同类型的数据
;; 返回 T 如果 a < b
(defun universal< (a b / type-a type-b)
(setq type-a (type a)
      type-b (type b))
;; 如果数据类型不同，则按类型的名称字符串排序 (e.g., INT < LIST < STR)
(if (/= type-a type-b)
    (< (vl-princ-to-string type-a) (vl-princ-to-string type-b))
    ;; 如果数据类型相同，则按各自的方式比较
    (cond
      ;; 数字或字符串，直接用 < 比较
      ((or (numberp a) (stringp a)) (< a b))
      ;; 其他类型（如列表、符号等），作为备用方案，比较它们的字符串表示形式
      ;; 注意：这个备用方案对于列表排序可能不完全符合直觉，但它提供了一个
      ;; 一致的排序结果，足以让 equal 的项聚集在一起。
      (t (< (vl-princ-to-string a) (vl-princ-to-string b)))
    )
)
)

;; 主函数：复杂度为 O(n log n) 的通用去重函数
;; (gps->lst-delsame '(1 nil 2 1 2 (1 1) nil (1 2 1 2 1) 1 2 (1 1) (1 2)))
;; -> (1 2 (1 1) (1 2 1 2 1) (1 2))
(defun gps->lst-delsame-fast (lst / indexed-lst i sorted-lst unique-indexed-lst n)
;; 1. 过滤 nil 并将每个项目与其原始索引配对
(setq i -1
      indexed-lst (list))
(foreach item lst
    (if item ; 过滤 nil
      (setq indexed-lst (cons (list item (setq i (1+ i))) indexed-lst))
    )
)
(setq indexed-lst (reverse indexed-lst)) ; O(n)

;; 如果列表为空，直接返回 nil
(if (null indexed-lst)
    (return-from gps->lst-delsame-fast nil)
)

;; 2. 排序，让所有 equal 的项相邻。这是核心步骤，O(n log n)
(setq sorted-lst
    (vl-sort
      indexed-lst
      '(lambda (pair-a pair-b / item-a item-b)
         (setq item-a (car pair-a)
               item-b (car pair-b))
         ;; 如果两项 equal，索引小的排前面（保留第一个出现的）
         (if (equal item-a item-b)
         (< (cadr pair-a) (cadr pair-b))
         ;; 如果不 equal，使用通用比较函数来决定顺序
         (universal< item-a item-b)
         )
       )
    )
)

;; 3. 遍历已排序列表，移除相邻的重复项。O(n)
(setq unique-indexed-lst (list (setq n (car sorted-lst)))
      sorted-lst (cdr sorted-lst))
(while sorted-lst
    ;; 如果当前项与上一唯一项不同，则将其添加
    (if (not (equal (car n) (caar sorted-lst)))
      (setq unique-indexed-lst (cons (setq n (car sorted-lst)) unique-indexed-lst))
    )
    (setq sorted-lst (cdr sorted-lst))
)

;; 4. 按原始索引重新排序，以恢复顺序。O(k log k)，k为唯一项数量
(setq unique-indexed-lst (vl-sort unique-indexed-lst '(lambda (a b) (< (cadr a) (cadr b)))))

;; 5. 提取项目本身，去掉索引
(mapcar 'car unique-indexed-lst)
)

AI写的 采用和 dup:pnts 类似的排序思想，我们成功地将通用去重函数 gps->lst-delsame 的时间复杂度优化到了 O(nlogn)

yanshengjiang 发表于 2025-9-19 15:38:06

诚然，又是一段AI代码，虽然可以执行但不知道效率怎么样

(defun dup:pnts (pl fuzz / l n i p tempList sortedList uniqueList)
;; 设置默认容差
(if (not fuzz)
    (setq fuzz 0.01)
)

(setq i 0)
(setq n (length pl))
(setq tempList '())

;; 第一步：为每个点创建带索引的列表，格式为 ((x y z) 原始索引)
(while (< i n)
    (if (setq p (nth i pl))
      (setq tempList (cons (list p i) tempList))
    )
    (setq i (1+ i))
)

;; 第二步：对临时列表进行排序
(setq sortedList
    (vl-sort tempList
      '(lambda (a b)
      (setq ptA (car a))
      (setq ptB (car b))
      (cond
          ;; 首先检查X坐标在容差范围内是否"相等"
          ((equal (car ptA) (car ptB) fuzz)
            (cond
            ;; 如果X"相等"，则检查Y坐标
            ((equal (cadr ptA) (cadr ptB) fuzz)
                ;; 如果X和Y都"相等"，则检查Z坐标
                (if (equal (caddr ptA) (caddr ptB) fuzz)
                  (< (cadr a) (cadr b)) ; XYZ都"相等"，按原始索引排序
                  (< (caddr ptA) (caddr ptB)) ; Z不"相等"，按Z坐标排序
                )
            )
            ;; 如果Y不"相等"，按Y坐标排序
            ((< (cadr ptA) (cadr ptB)) T)
            (T nil)
            )
          )
          ;; 如果X不"相等"，按X坐标排序
          ((< (car ptA) (car ptB)) T)
          (T nil)
      )
      )
    )
)

;; 第三步：遍历排序后的列表，去除重复点（基于容差）
(setq uniqueList '())
(while sortedList
    (setq uniqueList (cons (car sortedList) uniqueList))
    (setq currentPoint (caar sortedList))
    (setq sortedList (cdr sortedList))
   
    ;; 跳过所有与当前点"相等"的点
    (while (and sortedList (equal currentPoint (caar sortedList) fuzz))
      (setq sortedList (cdr sortedList))
    )
)

;; 第四步：按原始索引重新排序，恢复原始顺序
(setq uniqueList (vl-sort uniqueList '(lambda (a b) (< (cadr a) (cadr b)))))

;; 第五步：提取去重后的点（去掉索引信息）
(mapcar 'car uniqueList)
)

;; 示例1：处理二维点列表
(setq points2D '((1.0 2.0) (1.01 2.01) (1.02 2.02) (1.01 2.01) (3.0 4.0)))
(setq uniquePoints2D (dup:pnts points2D 0.05))
;; 返回: ((1.0 2.0) (3.0 4.0)) - 在0.05的容差下，前四个点被视为"相同"

;; 示例2：处理三维点列表
(setq points3D '(
    (1.0 2.0 3.0)
    (1.01 2.01 3.01)
    (1.02 2.02 3.02)
    (1.0 2.0 3.08) ; 与前三个点Z坐标不同
    (5.0 6.0 7.0)
))
(setq uniquePoints3D (dup:pnts points3D 0.05))
;; 返回: ((1.0 2.0 3.0) (1.0 2.0 3.08) (5.0 6.0 7.0))
;; 在0.05容差下，前三个点的XYZ都"相等"，但第四个点Z坐标不同

;; 示例3：不使用容差（完全精确匹配）
(setq exactPoints '((1 2 3.00001) (1 2 3) (4 5 6) (1 2 3) (7 8 9)))
(setq uniqueExact (dup:pnts exactPoints 0.0)) ; 容差为0，要求完全相等
;; 返回: ((1 2 3.00001) (1 2 3) (4 5 6) (7 8 9))

尘缘一生 发表于 2025-9-19 19:36:39

本帖最后由 尘缘一生 于 2025-9-19 19:59 编辑

根据上面两位的思路，整理一下，

经测试，速度不行，对点表的话是不行
对9万多个点位测试（特定图纸），本代码 22秒，用 dup:pnts用时 4秒左右，关键由于容差问题，去除的重复点少了2117个;删除表中重复和nil的项目(不支持表中表)----(一级)-----
;;(gps->lst-delsame '(1 nil 2 1 2 (1 1) nil (1 2 1 2 1) 1 2 (1 1) (1 2)))->(1 2 (1 1) (1 2 1 2 1) (1 2))
(defun gps->lst-delsame (lst / n i p l)
(setq i 0 n (length lst))
(while (< i n) ;过虑掉nil并构造索引表->l
    (if (setq p (car lst)) (setq l (cons (list p i) l)))
    (setq lst (cdr lst) i (1+ i))
)
(setq l
    (vl-sort l
      '(lambda (a b / tpa tpb)
         (if (equal (car a) (car b))
         (< (cadr a) (cadr b))
         (progn
             (setq tpa (type (car a)) tpb (type (car b)))
             (if (/= tpa tpb)
               (< (vl-princ-to-string tpa) (vl-princ-to-string tpb))
               (cond
               ((or (numberp (car a)) (= tpa 'str)) (< (car a) (car b)));数字或字符串,直接用 < 比较
               (t (< (vl-princ-to-string (car a)) (vl-princ-to-string (car b))));其他类型(如列表.符号等),作为备用方案,比较它们的字符串表示形式,足以让equal的项聚集在一起
               )
             )
         )
         )
       )
    )
)
(setq lst (list (setq n (car l))) l (cdr l))
(while l
    (if (not (equal (car n) (caar l)));如果当前项与上一唯一项不同,则将其添加
      (setq lst (cons (setq n (car l)) lst))
    )
    (setq l (cdr l))
)
(mapcar 'car (vl-sort lst '(lambda (a b) (< (cadr a) (cadr b)))))
)再次对 dup:pnts 调整
;(点表)->删除重复和nil的项 (不支持表中表)----(一级)-----
;fuzz 误差值或nil -->返回点表
(defun dup:pnts (pl fuzz / l n i p)
(if (not fuzz) (setq fuzz 0.01))
(setq i 0 n (length pl))
(while (< i n)
    (if (setq p (car pl)) (setq l (cons (list p i) l)))
    (setq pl (cdr pl) i (1+ i))
)
(setq l (vl-sort l
            '(lambda (a b)
               (if (equal (caar a) (caar b) fuzz)
               (< (cadar a) (cadar b))
               (cond
                   ((< (caar a) (caar b)) t)
                   ((and (= (caar a) (caar b)) (< (cadar a) (cadar b))) t)
                   ((and (= (caar a) (caar b)) (= (cadar a) (cadar b)) (< (caddar a) (caddar b))) t)
               )
               )
             )
          )
)
(setq pl (cons (setq n (car l)) pl) l (cdr l))
(while l
    (if (not (equal (car n) (caar l) fuzz)) (setq pl (cons (setq n (car l)) pl)))
    (setq l (cdr l))
)
(mapcar 'car (vl-sort pl '(lambda (a b) (< (cadr a) (cadr b)))))
)

zgs378530220 发表于 2025-9-20 05:58:02

(defun remove-nil-and-dup-top (lst)   (reverse   (car       (reduce         (function         (lambda (acc item)             (if (and item (not (member item (car acc) 'equal)))               (cons (cons item (car acc)) (cdr acc))               acc             )         )         )         (cons nil nil) ; 初始累加器         lst       )   )   ) )

查看完整版本: 点表去除重复和nil项