删除点集中的重复点

dnbcgrass · 发表于 2013-6-6 22:31:49

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 dnbcgrass 于 2013-6-6 23:41 编辑

下面是一个删除点集中重复点的函数，当点集的点数一万以上时耗用时间太多，大家有没有什么更快的方法？

;删除点集中重复的点
;用法：(del-pt 点集pts 判定点相同的限差eps)
;eps取1e-3
(defun del-pt (pts eps / fhz pt)
(setq fhz nil)
(while pts
(setq pt (car pts)
fhz (cons pt fhz)
pts (cdr pts)
pts (vl-remove-if '(lambda (x)
(equal x pt eps)
) pts
)
)
)
(setq fhz (reverse fhz))
)

Highflybird · 发表于 2013-6-6 23:07:27

试试这个：

;;;参数 Lst----点集
;;; tol----容差
(defun RemoveDup (lst Tol / L n)
(setq
lst
(vl-sort
lst
(function
(lambda (pt1 pt2)
(if (equal (car pt1) (car pt2) tol)
(if (equal (cadr pt1) (cadr pt2) tol)
(< (caddr pt1) (caddr pt2))
(< (cadr pt1) (cadr pt2))
)
(< (car pt1) (car pt2))
)
)
)
)
)
(while lst
(setq n (car lst))
(setq L (cons n L))
(while
(and
(cadr lst)
(equal (car lst) (cadr lst) tol)
)
(setq lst (cdr lst))
)
(setq lst (cdr lst))
)
(reverse L)
)
;;;example:
;;;(setq lst '((1235 255 140) (1258 230 150) (1258 230 150) (1263 262 160)))
;;;(setq lst (removeDup lst 0.))

QiaoCheng · 发表于 2013-6-6 22:46:31

你用这个测试下，看下要多长时间
http://www.xdcad.net/forum/thread-668673-1-1.html

Highflybird · 发表于 2013-6-6 23:08:54

点集数量多的时候一定要对点排序，不然效率不高。

XDSoft · 发表于 2013-6-6 23:14:44

楼主先给大家做个生成随机点的函数吧，然后根据这个函数随机生成1万个，然后大家测试下每个函数的效率。

Free-Lancer · 发表于 2013-6-6 23:46:04

Highflybird 发表于 2013-6-6 23:08
点集数量多的时候一定要对点排序，不然效率不高。

的确是这样，无序表判断是 n*(n-1)*(n-2)* .... 1
排序以后只有极端情况下才是上述情况，一般就是比较 car cadr

dnbcgrass · 发表于 2013-6-7 00:06:05

谢谢Highflybird，对于测试图，用你那个函数，快了几万倍！！！

eachy · 发表于 2013-6-7 00:23:31

dnbcgrass 发表于 2013-6-7 00:06
谢谢Highflybird，对于测试图，用你那个函数，快了几万倍！！！

这么夸张！把测试数据贴上来看看

Highflybird · 发表于 2013-6-7 00:57:50

本帖最后由 Highflybird 于 2013-6-7 11:29 编辑

我这里提供了一个lsp文件：
能创建大数量的随机点，并进行效率测试:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:rem-dup.LSP
下载次数:26 文件大小:4.58 KB
下载权限: 不限以上 [免费赚D豆]

里面已经包含了两位网友的方法。可以做比较。

ayl1004 · 发表于 2013-6-7 01:09:52

这基本上就不用测试了

HLCAD · 发表于 2013-6-7 08:15:39

判断点PT1与点PT2、误差精度为FUZZ（一个实数）是否相等，可用：
(equal pt1 pt2 fuzz)
如：(equal '(1.01 2.01 3.01) '(1.02 2.02 3.02) 0.5) 返回T

Love-Lisp · 发表于 2013-6-7 08:43:37

Highflybird 发表于 2013-6-6 23:07
试试这个：

...
(while lst
(setq n (car lst))
(setq L (cons n L))
(while
(and
(cadr lst)
(equal (car lst) (cadr lst) tol)
)
(setq lst (cdr lst))
)
(setq lst (cdr lst))
)
...

==>
改成这样，可以少运算几次

...
(while lst
(setq L (cons (setq n (car lst)) L)
lst (cdr lst)
)
(while
(and
lst
(equal (car lst) n tol)
)
(setq lst (cdr lst))
)
)
...

wowan1314 · 发表于 2013-6-7 09:37:17

本帖最后由 wowan1314 于 2013-6-7 09:43 编辑

我原来是这么写的！

(defun YY:PTSCF (PTS ZZ / A B)
(SETQ A NIL)
(foreach B PTS
(if (vl-member-if '(lambda(x) (equal X B ZZ)) A)
NIL
(setq A (CONS B A))
)
)
A
)

改成mapcar的

(defun PTSCF (PTS ZZ / A B)
(SETQ A NIL)
(mapcar '(lambda(b)
(if (vl-member-if '(lambda(x) (equal X B ZZ)) A)
NIL
(setq A (CONS B A))
)
)
pts)
A
)

wowan1314 · 发表于 2013-6-7 10:07:30

本帖最后由 wowan1314 于 2013-6-7 10:11 编辑

还是按楼主给的样本来测试好些。避免样本上的差别.1的测试时间24.3秒。2的测试时间0.28秒。时间差将近百倍。

;;测试
(DEFUN C:1 ( / SS PTS T1 T2 LST)
(SETQ SS (SSGET) LST (YY:SS2LST SS))
(setq pts (mapcar '(lambda(x) (dxf_read 10 x)) lst))
(SETQ T1 (get-utime))
(DEL-CF1 PTS 0.01)
(SETQ T2 (get-utime))
(PRINC "\nmapcar方法:")
(PRINC (- T2 T1))
(PRINC "S")
(PRINC)
)
;;测试
(DEFUN C:2 ( / SS PTS T1 T2 LST)
(SETQ SS (SSGET) LST (YY:SS2LST SS))
(setq pts (mapcar '(lambda(x) (dxf_read 10 x)) lst))
(SETQ T1 (get-utime))
(RemoveDup PTS 0.01)
(SETQ T2 (get-utime))
(PRINC "\n高飞鸟-方法:")
(PRINC (- T2 T1))
(PRINC "S")
(PRINC)
)

Highflybird · 发表于 2013-6-7 10:11:30

如果点只是平面上的点，可以进一步改进改进，在排序的时候，少作一次比较。
[pcode=lisp,true];;;参数 Lst----点集
;;;    tol----容差
;;;example:
;;;(setq lst '((1235 255 140) (1258 230 150) (1258 230 150) (1263 262 160)))
;;;(setq lst (removeDup lst 0.))
(defun RemoveDup (lst Tol / Ret n)
  (setq
lst
(vl-sort
   lst
   (function
      (lambda (pt1 pt2)
      (if (equal (car pt1) (car pt2) tol)
         (< (cadr pt1) (cadr pt2))
         (< (car pt1) (car pt2))
      )
      )
   )
)
  )
  (while lst
(setq Ret (cons (setq n (car lst)) Ret)
      lst (cdr lst)
)
(while (and lst (equal (car lst) n tol))
   (setq lst (cdr lst))
)
  )
  (reverse Ret)
)[/pcode]

账号		自动登录	找回密码
密码			立即注册

[研讨] 删除点集中的重复点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

评分

点评

点评

评分

点评

点评

点评

浏览过的版块