【越飞越高讲堂10】分治、递归、分类和最小距离(更新至2012.7）

highflybir · 发表于 2006-11-25 13:34

2012.7.16 程序更新在16楼。
=============================我是分割线=============================
给定平面上的一个数量为n的点集，如何能有效地找出距离最近的点对呢？（在实际中有着应用，而且给出的是点对的集合，也就是在误差范围内的所有点对都找出来）。
这个问题很容易理解，似乎也不难解决。我们只要将每一点与其他n-1个点的距离算出，找出达到最小距离的两个点即可。然而，这样做效率太低，需要O(n^2)的计算时间。当数量规模较小时，尚能解决，但一旦规模达到万级以上，其速度之慢，时间之长，无法令人忍受。下面我给出这个问题的一个θ(nlogn)算法。
在这个算法中，我利用了递归、分治和分类思想。
递归算法是自身调用自身函数的一种算法，例如求阶乘：
(defun jc(n) (if (= n 0) 1 (* n (jc (1- n)))))
分治算法是对于一个规模为n的问题，把它分解成为K个规模较小的子问题，这些子问题互相独立，且结构与原来问题的结构相同。在解这些子问题时，又对于每一个子问题进行进一步的分解，直到某个阈值为止。递归地解决这些子问题，再把各个子问题的解合并起来，就得到原来问题的解。因此递归一般和分治联系在一起。
对于求最小距离的解，我参考了一些资料，他们给出的大多是C++ 程序，我看不懂，只好按照算法和思想来设计lisp程序。
闲话少说，先看源程序:加载程序，运行TE

(defun C:te (/ olderr en errmsg oldmode oce sl ss t0 ptlist pp pp1)
;;定义错误函数和预处理
(setvar "errno" 0)
(setq olderr *error*)
(defun *error* (msg)
(setq en (getvar "errno"))
(setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))
(alert errmsg)
(setq *error* olderr)
)
(graphscr)
(setq oldmode (getvar "osmode"))
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command ".ucs" "W")
;;也可以用其他方式取得点集
(setq sl '((0 . "POINT")))
(setq t0 (getvar "TDUSRTIMER"))
(setq ss (ssget sl))
(setq ptlist (getpt ss))
;;分类
(setq t0 (getvar "TDUSRTIMER"))
(setq ptlist (sortx ptlist))
(princ "\n函数排序用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400))
(princ "秒")
;;函数用时估算，以了解函数性能
(setq t0 (getvar "TDUSRTIMER"))
(setq pp1 (f2 ptlist) pp (cadr pp1))
(princ "\n函数查找用时")
(princ (* (- (getvar "TDUSRTIMER") t0) 86400))
(princ "秒")
(if (= nil pp)
(progn
(alert "不存在有最小距离的一对点!")
(command ".ucs" "p")
(setvar "osmode" oldmode)
(setvar "cmdecho" oce)
(princ)
)
(progn
;;画最短距离的点对集的连线，可能有多条
(setvar "osmode" 0)
(foreach nn pp
(entmake
(append
'((0 . "line")(100 . "AcDbEntity")(100 . "AcDbLine"))
(list (cons 10 (car nn)))
(list (cons 11 (cadr nn)))
(list (cons 62 1))
)
)
)
(command ".ucs" "P")
(setvar "osmode" oldmode)
(setvar "cmdecho" oce)
(princ)
)
)
)
;;取点函数，其中i为点的编号
(defun getpt (ss / i listpp a b c)
(setq i 0 listpp nil )
(if ss
(repeat (sslength ss)
(setq a (ssname ss i))
(setq b (entget a))
(setq c (cdr (assoc 10 b)))
(setq listpp (cons c listpp))
(setq i (1+ i))
)
)
(reverse listpp)
)
;;从J到K的表
(defun cut (ptlist j k / i ptlist1)
(setq i 0 ptlist1 nil)
(foreach n ptlist
(if (and (>= i j) (<= i k) )
(setq ptlist1 (cons n ptlist1))
)
(setq i (1+ i))
)
(reverse ptlist1)
)
;;对X排序
(defun sortX (ptlist)
(mapcar '(lambda (x) (nth x ptlist))
(vl-sort-i ptlist '(lambda (e1 e2) (< (car e1)(car e2))))
)
)
;;在带形区域查找
(defun searchX (ptlist1 x1 x2 / pp)
(setq pp nil)
(foreach n ptlist1
(if (and (>= (car n) x1)
(<= (car n) x2)
)
(setq pp (cons n pp))
)
)
(reverse pp)
)
;;在矩形区域查找
(defun searchXY (ptlist2 x1 x2 y1 y2 / pp)
(setq pp nil)
(foreach n ptlist2
(if (and (>= (car n) x1)
(<= (car n) x2)
(>= (cadr n) y1)
(<= (cadr n) y2)
)
(setq pp (cons n pp))
)
)
(reverse pp)
)
;;最多6点最小距离
(defun 6ptmin (ptlist4 pt / 6pmin 6plist)
(setq 6pmin (mapcar '(lambda (x) (distance x pt)) ptlist4))
(setq 6pmin (apply 'min 6pmin) 6plist nil)
(foreach 6name ptlist4
(if (equal (distance 6name pt) 6pmin 1e-8)
(setq 6plist (cons (list pt 6name) 6plist))
)
)
(list (+ 6pmin 1e-8) 6plist)
)
;;***************
;;程序主段-------
(defun f2 (ptlist / l p1 p2 p3 dd 3pmind 3plist ptlist1 ptlist2 ptlist3 ptlist4
n m midpt mind1 mind2 mindt a b c d Dismin Dnmin nplist mindi)
(setq l (length ptlist))
(cond
( (= l 2);;两点还用说
(list (+ (distance (car ptlist) (cadr ptlist)) 1e-8)
(list ptlist)
)
;;(list (apply 'distance ptlist) (list ptlist))
)
( (= l 3);;三点最小距离直接求解点对
(progn
(setq p1 (car ptlist) p2 (cadr ptlist) p3 (caddr ptlist))
(setq dd
(list (list (distance p1 p2) (list p1 p2))
(list (distance p1 p3) (list p1 p3))
(list (distance p2 p3) (list p2 p3))
)
)
(setq 3pmind (apply 'min (mapcar 'car dd)))
(setq 3plist nil)
(foreach 3name dd
(if (equal (car 3name) 3pmind 1e-8)
(setq 3plist (cons (cadr 3name) 3plist))
)
)
(list (+ 3pmind 1e-8) 3plist)
)
)
( (> l 3)
(progn
(setq n (/ l 2) m (- l n));;分治
(setq ptlist1 (cut ptlist 0 (1- m)))
(setq ptlist2 (cut ptlist m l))
(setq midpt (last ptlist1))
(setq mind1 (f2 ptlist1));;递归左边
(setq mind2 (f2 ptlist2));;递归右边
(setq mindT
(cond
((equal (car mind1) (car mind2) 1e-8)(list (car mind1) (append (cadr mind1) (cadr mind2))))
((< (car mind1) (car mind2)) mind1)
(t mind2)
)
)
(setq mindi (car mindT))
(setq a (- (car midpt) mindi) b (car midpt))
(setq ptlist3 (searchX ptlist1 a b))
(if (/= ptlist3 nil)
(progn
(setq Dismin nil)
(foreach name ptlist3
(setq a (car midpt) b (+ (car midpt) mindi) c (- (cadr name) mindi) d (+ (cadr name) mindi))
(setq ptlist4 (searchXY ptlist2 a b c d))
(if (/= ptlist4 nil)
(setq Dismin (cons (6ptmin ptlist4 name) Dismin))
)
)
(if (= Dismin nil)
mindT
(progn
(setq Dnmin (apply 'min (mapcar 'car Dismin)) nplist nil)
(foreach npname Dismin
(if (equal (car npname) Dnmin 1e-8)
(setq nplist (append (cadr npname) nplist))
)
)
(cond
((equal (car mindT) Dnmin 1e-8) (list mindi (append nplist (cadr mindT))))
((< (car mindT) Dnmin) mindT)
(t (list Dnmin nplist))
);;for inest cond
);;for inest if-progn
);;for inest if
)mindT;;for if-progn
);;for if
);;for cond-last-progn
);;for cond-last
);;for cond
);;for defun
;;***************

(defun C:te (/ olderr en errmsg oldmode oce sl ss t0 ptlist pp pp1) 
  ;;定义错误函数和预处理 
  (setvar "errno" 0) 
  (setq olderr *error*) 
  (defun *error* (msg) 
    (setq en (getvar "errno")) 
    (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg)) 
    (alert errmsg) 
    (setq *error* olderr) 
  ) 
  (graphscr) 
  (setq oldmode (getvar "osmode")) 
  (setq oce (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command ".ucs" "W") 
  ;;也可以用其他方式取得点集 
  (setq sl '((0 . "POINT"))) 
  (setq t0 (getvar "TDUSRTIMER")) 
  (setq ss (ssget sl)) 
  (setq ptlist (getpt ss)) 
  ;;分类 
  (setq t0 (getvar "TDUSRTIMER")) 
  (setq ptlist (sortx ptlist)) 
  (princ "\n函数排序用时") 
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400)) 
  (princ "秒") 
  ;;函数用时估算，以了解函数性能 
  (setq t0 (getvar "TDUSRTIMER")) 
  (setq pp1 (f2 ptlist) pp (cadr pp1)) 
  (princ "\n函数查找用时") 
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400)) 
  (princ "秒") 
  (if (= nil pp) 
    (progn 
      (alert "不存在有最小距离的一对点!") 
      (command ".ucs" "p") 
      (setvar "osmode" oldmode) 
      (setvar "cmdecho" oce) 
      (princ) 
    ) 
    (progn 
      ;;画最短距离的点对集的连线，可能有多条 
      (setvar "osmode" 0) 
      (foreach nn pp 
        (entmake 
   (append 
     '((0 . "line")(100 . "AcDbEntity")(100 . "AcDbLine")) 
     (list (cons 10 (car  nn))) 
     (list (cons 11 (cadr nn))) 
     (list (cons 62 1)) 
   ) 
        ) 
      ) 
      (command ".ucs" "P") 
      (setvar "osmode" oldmode) 
      (setvar "cmdecho" oce) 
      (princ) 
    ) 
  ) 
) 
;;取点函数，其中i为点的编号 
(defun getpt (ss / i listpp a b c) 
  (setq i 0 listpp nil ) 
  (if ss 
    (repeat (sslength ss) 
      (setq a (ssname ss i)) 
      (setq b (entget a)) 
      (setq c (cdr (assoc 10 b))) 
      (setq listpp (cons c listpp)) 
      (setq i (1+ i))   
    ) 
  ) 
  (reverse listpp) 
) 
;;从J到K的表 
(defun cut (ptlist j k / i ptlist1) 
  (setq i 0 ptlist1 nil) 
  (foreach n ptlist 
    (if (and (>= i j) (<= i k) ) 
      (setq ptlist1 (cons n ptlist1)) 
    ) 
    (setq i (1+ i)) 
  ) 
  (reverse ptlist1) 
) 
;;对X排序 
(defun sortX (ptlist) 
  (mapcar '(lambda (x) (nth x ptlist)) 
    (vl-sort-i ptlist '(lambda (e1 e2) (< (car e1)(car e2)))) 
  ) 
) 
;;在带形区域查找 
(defun searchX (ptlist1 x1 x2 / pp) 
  (setq pp nil) 
  (foreach n ptlist1 
    (if (and (>= (car n) x1) 
      (<= (car n) x2) 
) 
      (setq pp (cons n pp)) 
    ) 
  ) 
  (reverse pp) 
) 
;;在矩形区域查找 
(defun searchXY (ptlist2 x1 x2 y1 y2 / pp) 
  (setq pp nil) 
  (foreach n ptlist2 
    (if (and (>= (car  n) x1) 
      (<= (car  n) x2) 
      (>= (cadr n) y1) 
      (<= (cadr n) y2) 
) 
      (setq pp (cons n pp)) 
    ) 
  ) 
  (reverse pp) 
) 
;;最多6点最小距离 
(defun 6ptmin (ptlist4 pt / 6pmin 6plist) 
  (setq 6pmin (mapcar '(lambda (x) (distance x pt)) ptlist4)) 
  (setq 6pmin (apply 'min 6pmin) 6plist nil) 
  (foreach 6name ptlist4 
    (if (equal (distance 6name pt) 6pmin 1e-8) 
      (setq 6plist (cons (list pt 6name) 6plist)) 
    )   
  ) 
  (list (+ 6pmin 1e-8) 6plist)          
) 
;;*************** 
;;程序主段------- 
(defun f2 (ptlist / l p1 p2 p3 dd 3pmind 3plist ptlist1 ptlist2 ptlist3 ptlist4   
          n m midpt mind1 mind2 mindt a b c d Dismin Dnmin nplist mindi) 
  (setq l (length ptlist)) 
  (cond 
    ( (= l 2);;两点还用说    
      (list (+ (distance (car ptlist) (cadr ptlist)) 1e-8) 
     (list ptlist) 
      ) 
      ;;(list (apply 'distance ptlist) (list ptlist)) 
    ) 
    ( (= l 3);;三点最小距离直接求解点对 
      (progn 
(setq p1 (car ptlist) p2 (cadr ptlist) p3 (caddr ptlist)) 
(setq dd 
          (list (list (distance p1 p2) (list p1 p2)) 
  (list (distance p1 p3) (list p1 p3)) 
  (list (distance p2 p3) (list p2 p3)) 
   ) 
) 
(setq 3pmind (apply 'min (mapcar 'car dd))) 
(setq 3plist nil) 
(foreach 3name dd 
   (if (equal (car 3name) 3pmind 1e-8) 
     (setq 3plist (cons (cadr 3name) 3plist)) 
   ) 
) 
        (list (+ 3pmind 1e-8) 3plist) 
      ) 
    ) 
    ( (> l 3) 
      (progn 
(setq n (/ l 2) m (- l n));;分治 
(setq ptlist1 (cut ptlist 0 (1- m))) 
(setq ptlist2 (cut ptlist m l)) 
(setq midpt (last ptlist1)) 
(setq mind1 (f2 ptlist1));;递归左边 
(setq mind2 (f2 ptlist2));;递归右边 
(setq mindT 
   (cond 
     ((equal (car mind1) (car mind2) 1e-8)(list (car mind1) (append (cadr mind1) (cadr mind2)))) 
     ((< (car mind1) (car mind2)) mind1) 
     (t mind2) 
   ) 
) 
(setq mindi (car mindT)) 
(setq a (- (car midpt) mindi) b (car midpt)) 
(setq ptlist3 (searchX ptlist1 a b)) 
(if (/= ptlist3 nil) 
   (progn 
     (setq Dismin nil) 
            (foreach name ptlist3 
       (setq a (car midpt) b (+ (car midpt) mindi) c (- (cadr name) mindi) d (+ (cadr name) mindi)) 
       (setq ptlist4 (searchXY ptlist2 a b c d)) 
       (if (/= ptlist4 nil) 
                (setq Dismin (cons (6ptmin ptlist4 name) Dismin)) 
       ) 
     ) 
     (if (= Dismin nil) 
       mindT 
       (progn 
         (setq Dnmin (apply 'min (mapcar 'car Dismin)) nplist nil) 
  (foreach npname Dismin 
    (if (equal (car npname) Dnmin 1e-8) 
      (setq nplist (append (cadr npname) nplist)) 
    ) 
  ) 
         (cond 
    ((equal (car mindT) Dnmin 1e-8) (list mindi (append nplist (cadr mindT)))) 
    ((< (car mindT) Dnmin) mindT)   
           (t (list Dnmin nplist)) 
         );;for inest cond 
       );;for inest if-progn 
     );;for inest if 
   )mindT;;for if-progn 
);;for if 
      );;for cond-last-progn 
    );;for cond-last 
  );;for cond 
);;for defun 
;;***************

比较了一些别人写的代码，（大都是平方级别的，有的甚至更高），发现在时间上还是比平方级以上的要快很多。但是还没有做最优处理，希望大家多多提意见给我。

highflybird@sina.com
2006-11-25,kunming

以下图片给出了一个极端例子：

highflybir · 发表于 2012-7-17 09:46

现在更新了程序。比以前的快了十倍。
同时附上国外的一个好方法。
命令是:test.

highflybir · 发表于 2006-11-25 15:16

这个题的算法步骤如下：

1、首先把点集按照X从小到大分类，

2、先求两点和三点的最小距离点对。

3、对于大于三点以上的N个点，做如下考虑：

a,把点按照中位数分开。（例如，19个点，则左边10个，右边9个，18个对分）

b,对两边分别用递归方法求解。得到两个最小的距离d1和d2

c ,比较d1或者d2大小，取最小的为dmin

d ,设置中位点X坐标为xmid ，对于落在 (xmid-dmin,xmid) 区域上的点(xscan, yscan) 进行扫描X落在（dmin,xmid+dmin）Y落在( yscan-dmin,yscan+xdmin) 右边的点(理论证明最多有6个这样的点)，分别求左边扫描的点跟右边区域的点的距离，找到距离的最小，然后从最小的合集中找到最小 midarea-min,把这个值跟dmin做比较，这样就可以得出最小的距离以及它们的点对。

如果不明白的话，可以参考一些书籍和网上的资料。

一张单程票 · 发表于 2022-6-3 10:15

好贴，顶一个不解释

tcsl9621 · 发表于 2006-11-25 13:42

好帖！顶到底。

tcsl9621 · 发表于 2006-11-25 14:44

算法对程序来说至关重要，还请楼主给大伙讲一讲数据结构和算法。

ddd010 · 发表于 2009-2-24 22:40

学习ing

haifeng168 · 发表于 2009-2-26 12:33

感谢版主分享，谢谢

dkj0322 · 发表于 2010-10-11 11:39

谢谢楼上的分享，参考下，很感激

myjping · 发表于 2012-4-21 07:18

我试用下有两问题，一是点有可能重合，二发现不能求得最小值，这个不知为什么

fdb2007 · 发表于 2012-5-6 19:07

好程序，谢谢分享

wowan1314 · 发表于 2012-5-6 19:12

本帖最后由 wowan1314 于 2012-5-6 19:15 编辑

NB,收藏了！有时间下来好好学习研究. 谢谢楼主分享。

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

[【高飞鸟】] 【越飞越高讲堂10】分治、递归、分类和最小距离(更新至2012.7）

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

本帖子中包含更多资源

点评