(XD::Pnts:RemoveDup)点表消除重复点

st788796

要达到彻底，遍历是少不了的，即使是 n2
1 扫描 X  删 equal 点
2 对剩余表扫描 Y  向，删除 equal 点

vl-sort 排序是确定第一个基点后，按规则找到距基点满足条件的一个点（可能有多个满足但只取其一, 有不确定性)，然后将这个点做基点再找下一个，.... 直至表结束
如图，如果左下为基点时，规则定的向右，那到行尾才接续第二行，这时消重就不会消掉第二行
同理向上排的时候也不会消掉第二列

st788796

守仁格竹GM 发表于 2013-11-14 17:31
不过我又改进了一下0.8740秒
(defun Pnts:RemoveDups (pts fuzz / i ptl)
  (setq i -1

就像 ll_j  长老说的，只扫描了一个方向，少另外一个方向

eachy

双向扫描的消重点

1. (defun XD::Pnts:RemoveDup (pts  fuzz / remove i)
   
2.   (defun remove        (pts fuzz / ptl)
   
3.     (while pts
   
4.       (if (equal (caar pts) (caar ptl) fuzz)
   
5.         (setq pts (cdr pts))
   
6.         (setq ptl (cons (car pts) ptl)
   
7.               pts (cdr pts)
   
8.         )
   
9.       )
   
10.     )
    
11.     ptl
    
12.   )
    
13.   (setq i 0
    
14.           pts (mapcar '(lambda (x) (cons x (setq i (1+ i)))) pts)
    
15.         pts (vl-sort pts
    
16.                      '(lambda (p1 p2)
    
17.                         (if (= (cadar p1) (cadar p2))
    
18.                           (< (caar p1) (caar p2))
    
19.                           (< (cadar p1) (cadar p2))
    
20.                         )
    
21.                       )
    
22.             )
    
23.         pts (remove pts fuzz)
    
24.         pts (vl-sort pts
    
25.                      '(lambda (p1 p2)
    
26.                         (if (= (caar p1) (caar p2))
    
27.                           (< (cadar p1) (cadar p2))
    
28.                           (< (caar p1) (caar p2))
    
29.                         )
    
30.                       )
    
31.             )
    
32.         pts (remove pts fuzz)
    
33.         pts (vl-sort pts
    
34.                      '(lambda (p1 p2) (< (cdr p1) (cdr p2)))
    
35.             )
    
36.         pts (mapcar 'car pts)
    
37.   )
    
38.   pts
    
39. )
    

(defun XD::Pnts:RemoveDup (pts  fuzz / remove i)<br />   (defun remove        (pts fuzz / ptl)<br />     (while pts<br />       (if (equal (caar pts) (caar ptl) fuzz)<br />         (setq pts (cdr pts))<br />         (setq ptl (cons (car pts) ptl)<br />               pts (cdr pts)<br />         )<br />       )<br />     )<br />     ptl<br />   )<br />   (setq i 0 <br />           pts (mapcar '(lambda (x) (cons x (setq i (1+ i)))) pts)<br />         pts (vl-sort pts<br />                      '(lambda (p1 p2)<br />                         (if (= (cadar p1) (cadar p2))<br />                           (< (caar p1) (caar p2))<br />                           (< (cadar p1) (cadar p2))<br />                         )<br />                       )<br />             )<br />         pts (remove pts fuzz)<br />         pts (vl-sort pts<br />                      '(lambda (p1 p2)<br />                         (if (= (caar p1) (caar p2))<br />                           (< (cadar p1) (cadar p2))<br />                           (< (caar p1) (caar p2))<br />                         )<br />                       )<br />             )<br />         pts (remove pts fuzz)<br />         pts (vl-sort pts<br />                      '(lambda (p1 p2) (< (cdr p1) (cdr p2)))<br />             )<br />         pts (mapcar 'car pts)<br />   )<br />   pts<br /> )<br />

redcat2012

eachy 发表于 2013-12-15 14:24
双向扫描的消重点

1. (defun Pnts:RemoveDups (pts fuzz / ptl tmp)
   
2.   (setq  pts (vl-sort pts
   
3.          '(lambda (p1 p2)
   
4.       (if (= (car p1) (car p2))
   
5.         (< (cadr p1) (cadr p2))
   
6.         (< (car p1) (car p2))
   
7.       ) ;_ 结束if
   
8.           ) ;_ 结束lambda
   
9.       ) ;_ 结束vl-sort
   
10.   ) ;_ 结束setq
    
11.   (while pts
    
12.     (setq tmp (car pts)
    
13.     ptl (cons tmp ptl)
    
14.     pts (vl-remove-if '(lambda (n)
    
15.              (and (equal (car tmp) (car n) fuzz)
    
16.             (equal (cadr tmp) (cadr n) fuzz)
    
17.              ) ;_ 结束and
    
18.            ) ;_ 结束lambda
    
19.           (cdr pts)
    
20.         ) ;_ 结束vl-remove-if
    
21.     ) ;_ 结束setq
    
22.   ) ;_ 结束setq
    
23.   (reverse ptl)
    
24. ) ;_ 结束defun

(defun Pnts:RemoveDups (pts fuzz / ptl tmp)<br />   (setq  pts (vl-sort pts<br />          '(lambda (p1 p2)<br />       (if (= (car p1) (car p2))<br />         (< (cadr p1) (cadr p2))<br />         (< (car p1) (car p2))<br />       ) ;_ 结束if<br />           ) ;_ 结束lambda<br />       ) ;_ 结束vl-sort<br />   ) ;_ 结束setq<br />   (while pts<br />     (setq tmp (car pts)<br />     ptl (cons tmp ptl)<br />     pts (vl-remove-if '(lambda (n)<br />              (and (equal (car tmp) (car n) fuzz)<br />             (equal (cadr tmp) (cadr n) fuzz)<br />              ) ;_ 结束and<br />            ) ;_ 结束lambda<br />           (cdr pts)<br />         ) ;_ 结束vl-remove-if<br />     ) ;_ 结束setq<br />   ) ;_ 结束setq<br />   (reverse ptl)<br /> ) ;_ 结束defun

st788796

仅排一次还是在"有序"与"无序"之间

newer

ll_j 发表于 2013-11-14 14:34
我的观点是，排序不要误差，删除时再使用误差，否则就像我那个“间苗”的帖子一样。

要误差时候有要误差的应用，不要误差FUZZ给0就可以了。

lifei18

这个对自动标数很有用

Bao_lai

很腻害了。

dyjwyqz5221

旧事重提，经过2912个点的点表，去重测试，该函数较慢。
以下为三个不同函数的测试结果：
;;;函数1：
(defun XD::Pnts:RemoveDup1 (pts fuzz / pt1 pts-1)
        (xdrx_runtime t)
          (while (setq pt1 (car pts))
                (setq pts
                        (vl-remove-if
                                '(lambda (x)
                                        (equal x pt1 fuzz)
                                );;;lambda
                                (cdr pts)
                        );;;vl-remove-if-not
                );;;setq
                      (setq pts-1 (cons pt1 pts-1))
             );;;while
              (reverse pts-1)
        (xdrx_prompt "\n用时 "(xdrx_runtime)" 秒")
);;;defun
用时：0.003s 最快


;;;函数2：
(defun yqz::qc (pts / n pts1 lst-num)
        (xdrx_runtime t)
        (setq n -1
                pts
                (mapcar
                        '(lambda(x)
                                (setq n (1+ n))
                                (list x n)
                        )
                        pts
                );;;mapcar
                pts (xd::list:groupbyindex pts 1e-3)
                pts1 (mapcar 'car pts)
                lst-num (mapcar 'cadr pts)
        );;;setq
        (mapcar 'cadr (vl-sort (apply 'mapcar (cons 'list (list lst-num pts1))) '(lambda (a b) (< (car a) (car b)))))
        (xdrx_prompt "\n用时 "(xdrx_runtime)" 秒")
);;;defun  
用时：0.009s 较快


;;;函数3：
(defun xd::dup (pts)
        (xdrx_runtime t)
        (XD::Pnts:RemoveDup pts 1e-3)
        (xdrx_prompt "\n用时 "(xdrx_runtime)" 秒")
);;;defun
用时：0.059s 最慢

qyming2000

去重函数  
来自: 微社区

fengyun7000

这是双向扫描，再来个三向的吧，Z方向的

dyjwyqz5221

经测试，两个点的(equal  pt1 pt2 fuzz)并不是距离pt1误差fuzz范围内的点相等，而是指点的x、y、z坐标各自的误差是否在fuzz范围内，望大家注意。

dyjwyqz5221

例如：(distance '(1 2 3) '(1.1 2.12 3.1)) 值为0.185472
(equal '(1 2 3) '(1.1 2.12 3.1) 0.121) 返回：T

dyjwyqz5221

做了个有容差的消重点表函数与XD::pnts:RemoveDup进行效率比较：
(defun XD::pnts:RemoveDup-fuzz(lst fuzz / foo index)
    (defun foo (x)
        (cond
            ((xd::list:member-fuzz x index fuzz))
            ((null (setq index (cons x index))))
        )
    )
    (vl-remove-if
       'foo
        lst
    )
);;;defun

;;;有容差的member
(defun xd::list:member-fuzz(e lst fuzz)
        (while (and lst (not (equal (car lst) e fuzz)))
                (setq lst (cdr lst))
        );;;while
        (car lst)
);;;defun
测试函数：
(defun c:tt(/ pts)
        (setq pts (xdrx_entity_getstretchpoint (car(entsel)))
                pts (append pts pts pts pts pts pts pts pts pts pts)
        );;;setq
        (repeat 5
                  (xd::quickbench '((XD::pnts:RemoveDup-fuzz pts 1e-3)(XD::Pnts:RemoveDup pts 1e-3)))
        )
          (princ)
)

测试结果：
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ....... done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1609       1609     16.79 <fastest>
(XD::PNTS:REMOVEDUP PTS 0...)      256      1688      27008      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ....... done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1469       1469     13.27 <fastest>
(XD::PNTS:REMOVEDUP PTS 0...)      256      1218      19488      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ....... done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1469       1469     13.45 <fastest>
(XD::PNTS:REMOVEDUP PTS 0...)      256      1235      19760      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ....... done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1469       1469     13.10 <fastest>
(XD::PNTS:REMOVEDUP PTS 0...)      256      1203      19248      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ....... done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1453       1453     13.25 <fastest>
(XD::PNTS:REMOVEDUP PTS 0...)      256      1203      19248      1.00 <slowest>
-------------------------------------------------------------------------------

dyjwyqz5221

与之前我使用的一个点表消重函数比较：
(defun XD::Pnts:RemoveDup2(pts fuzz / pt1 pts-1)
          (while (setq pt1 (car pts))
                (setq pts
                        (vl-remove-if
                                '(lambda (x)
                                        (equal x pt1 fuzz)
                                );;;lambda
                                (cdr pts)
                        );;;vl-remove-if
                              pts-1 (cons pt1 pts-1)
                );;;setq
             );;;while
              (reverse pts-1)
)


(defun c:tt(/ pts)
        (setq pts (xdrx_entity_getstretchpoint (car(entsel)))
                pts (append pts pts pts pts pts pts pts pts pts pts)
        );;;setq
        (repeat 5
                  (xd::quickbench '((XD::pnts:RemoveDup-fuzz pts 1e-3)(XD::Pnts:RemoveDup pts 1e-3)(XD::Pnts:RemoveDup2 pts 1e-3)))
        )
          (princ)
);;;defun


CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ........ done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1562       1562     17.45 <fastest>
(XD::PNTS:REMOVEDUP2 PTS ...)     2048      1500       3000      9.09
(XD::PNTS:REMOVEDUP PTS 0...)      256      1704      27264      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ........ done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1484       1484     16.35 <fastest>
(XD::PNTS:REMOVEDUP2 PTS ...)     2048      1547       3094      7.84
(XD::PNTS:REMOVEDUP PTS 0...)      256      1516      24256      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ........ done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1516       1516     15.99 <fastest>
(XD::PNTS:REMOVEDUP2 PTS ...)     2048      1547       3094      7.83
(XD::PNTS:REMOVEDUP PTS 0...)      256      1515      24240      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ........ done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1500       1500     16.17 <fastest>
(XD::PNTS:REMOVEDUP2 PTS ...)     2048      1531       3062      7.92
(XD::PNTS:REMOVEDUP PTS 0...)      256      1516      24256      1.00 <slowest>
-------------------------------------------------------------------------------
CPU:(1x)Intel(R) Core(TM) i7-7700 @ 3.60GHz 4Cores  / Memory:24G / OS:WIN10专业版
Benchmarking ........ done for 4096 iterations. Sorted from fastest.
Statement                    Increment  Time(ms)  Normalize  Relative
-------------------------------------------------------------------------------
(XD::PNTS:REMOVEDUP-FUZZ ...)     4096      1515       1515     16.01 <fastest>
(XD::PNTS:REMOVEDUP2 PTS ...)     2048      1531       3062      7.92
(XD::PNTS:REMOVEDUP PTS 0...)      256      1516      24256      1.00 <slowest>
-------------------------------------------------------------------------------