点集配对

aimisiyou · 发表于 2020-1-28 09:31:56

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

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

×

平面上有2n个点，两两配对后得到n条线段，如何配对使得n条线段的总长最小？

qqqincccken · 发表于 2020-1-28 10:38:13

期待高手的解答学习一下

tzfcn · 发表于 2020-1-28 12:38:28

那得使所有的点间的距离对最小，计算量不小。

aimisiyou · 发表于 2020-1-28 12:44:10

本帖最后由 aimisiyou 于 2020-1-28 13:38 编辑

目前想到一个近似算法，算法如下:
1、以最低最左点为第一点，配对与第一点最近的点为第二点，与第一点最远的点为第三点；
2、从点集里删除第一、第二点，从剩余点集里配对与第三点最近的点为第四点，与第三点最远的点为第五点；
3、从点集里删除第三，第四点，从剩余点集里配对与第五点最近的点为第六点，与第五点最远的点为第七点；
...
直至所有配对完成。

aimisiyou · 发表于 2020-1-28 12:45:34

本帖最后由 aimisiyou 于 2020-1-28 13:01 编辑

有点类似背包问题，如果前面都配对最近的，后面剩下的的配对距离会变大。

aimisiyou · 发表于 2020-1-28 13:03:08

tzfcn 发表于 2020-1-28 12:38
那得使所有的点间的距离对最小，计算量不小。

准确来说，应该是距离总和达到最小。

aimisiyou · 发表于 2020-1-28 21:43:26

本帖最后由 aimisiyou 于 2020-1-28 23:32 编辑

aimisiyou 发表于 2020-1-28 12:44
目前想到一个近似算法，算法如下:
1、以最低最左点为第一点，配对与第一点最近的点为第二点，与第一点最远 ...

经验证，此算法不正确。如四点（等腰梯形底窄上宽）情况的结果不正确。

aimisiyou · 发表于 2020-1-29 00:00:01

本帖最后由 aimisiyou 于 2020-1-29 00:10 编辑

考虑到正确的算法起码要保证任何四点情况的正确性，联想到采取最小生成树算法，从度数为1的点且与之相连的线段最长的点开始配对。剔除已配对好的1、2两点后，余下的点生成最小生成树，仍从度数为1的点且与之相连的线段最长的点开始配对...直至所有配对完成。不知此算法是否正确，但至少任意四点情况是正确的，且对于大于4点的2n个点的结果也是较优解。算法复杂度为O(n^2)。

aimisiyou · 发表于 2020-1-29 00:23:04

上述算法四点情况好像也存在反例，如最小生成树是两腰和底，但两腰之和大于上底和下底之和。

aimisiyou · 发表于 2020-1-30 01:20:46

本帖最后由 aimisiyou 于 2020-1-30 01:34 编辑

近似算法得到如图结果。

aimisiyou · 发表于 2020-1-31 00:39:56

猜想：2n个点的最小权值匹配即是2n个点的tsp结果中奇偶边(1-2、3-4、5-6……)或偶奇边（2-3、4-5、6-7……）总和较小的一组。

aimisiyou · 发表于 2020-1-31 01:55:08

本帖最后由 aimisiyou 于 2020-1-31 02:56 编辑

;;;2n个点最小权值匹配。
;;;程序基于猜想：2n个点的最小权值匹配即是2n个点的tsp结果中奇偶边(1-2、3-4、5-6……)或偶奇边（2-3、4-5、6-7……）总和较小的一组。
;;;结果不能保证一定是最优解，但在运行时间可接受范围内也可算是较优解
;;;50个点大约运行3分钟

(defun c:tt ()
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
(setq count (length lst) nc 0 picklst nil)
(while (<= nc j)
   (if (<= i nc)
         (setq picklst (cons (nth nc lst) picklst))
   )
   (setq nc (+ nc 1))
)
(reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
   (setq klst (cons i klst))
   (setq i (+ 1 i))
)
(while (<= j 20)
      (setq i_pot (rnd_n n))
      (setq j_pot (rnd_n n))
      (setq nmin (min i_pot j_pot))
      (setq nmax (max i_pot j_pot))
      (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
      (setq j (+ j 1))
)
(mapcar '1- klst)
)
(defun fitfun (ptlst)
  (apply '+ (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst)))))
)
;;;取点函数
(defun fp ()
(setq sn (ssget ":N" '((0 . "point"))))
(setq i 0 n (sslength sn) pts nil)
(while (< i n)
      (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
      (setq i (+ i 1))
)
(reverse pts)
)
(setq pts (fp))
(setq poplst nil)
(repeat 100
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y))
                                    poplst
                                    poplst
                                                      )
                           '(lambda (e1 e2)  (< (car e1) (car e2)) )
                  )
            )
)
(setq p_chane 0.02  N_d 3000 ii 0)
(while (< ii N_d)
(setq vlst nil)
(foreach en poplst
   (setq nt (length en))
   (setq  ens en pc1 (nth (rnd_n nt) ens) flag t clst (list pc1))
   (while flag
         (setq r_rnd (rnd))
         (if (< r_rnd p_chane)
                        (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 ens)))
            (progn
                  (setq en_rnd (nth (rnd_n nt) poplst))
                                    (if (= pc1 (last en_rnd))
                                          (setq pc2 (car en_rnd))
                                          (setq pc2 (cadr (member pc1 en_rnd)) )
                                    )
                              )
                        )
                     (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                           (setq flag nil)
               (progn
                  (if (member pc2 (member pc1 ens))
                     (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                        (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                  )
                  (setq pc1 pc2)
                                       (setq clst (cons pc1 clst))
                                       (if (= (length clst) (- nt 1))
                                          (setq flag nil)
                                       )
                              )
                     )
         )
   (if (< (fitfun (n-pt ens)) (fitfun (n-pt en)))
               (setq vlst (cons ens vlst))
            (setq vlst (cons en  vlst))
         )
      )
(setq ii (+ 1 ii))
(setq poplst vlst)
(setq p_bestnew  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y)) poplst poplst)
                                          '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                 )
                              )
               )
  (if (< (car p_bestnew) (car p_best) )
   (setq  p_best p_bestnew)
)
)
(setq tsp_pts (n-pt (cdr p_best)) numii 0  numjj 0)
(setq pts1 (vl-remove nil (mapcar '(lambda (x) (if (= 0 (rem (setq numii (+ numii 1)) 2)) nil x)) tsp_pts)))
(setq pts2 (vl-remove nil (mapcar '(lambda (x) (if (= 0 (rem (setq numjj (+ numjj 1)) 2)) x nil)) tsp_pts)))
(setq LD (apply '+ (mapcar 'distance tsp_pts (reverse (cons (car tsp_pts) (reverse (cdr tsp_pts)))))))
(setq LD1 (apply '+ (mapcar 'distance pts1 pts2)))
(if (< (* 2 LD1 LD))
(mapcar '(lambda (x y) (command "line" x y "")) pts1 pts2)
(mapcar '(lambda (x y) (command "line" x y "")) (reverse (cons (car pts1) (reverse (cdr pts1)))) pts2)
)
)

aimisiyou · 发表于 2020-2-1 01:26:50

本帖最后由 aimisiyou 于 2020-2-1 01:30 编辑

;;;通过检验，上述算法是绕弯了而且还绕错了。采用遗传算法直接选路径求其适应度，最小的即为最优配对。
(defun c:tt()
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun rnd_n (n)
  (fix (* n (rnd)))
)
(defun pick (lst i j)
(setq count (length lst) nc 0 picklst nil)
(while (<= nc j)
   (if (<= i nc)
         (setq picklst (cons (nth nc lst) picklst))
   )
   (setq nc (+ nc 1))
)
(reverse picklst)
)
;;;重新洗牌
(defun xipai (n)
  (setq i 1 j 0 klst nil)
  (while (<= i n)
   (setq klst (cons i klst))
   (setq i (+ 1 i))
)
(while (<= j 20)
      (setq i_pot (rnd_n n))
      (setq j_pot (rnd_n n))
      (setq nmin (min i_pot j_pot))
      (setq nmax (max i_pot j_pot))
      (setq klst (append (pick klst  (+ 1 nmax) (- n 1)) (pick klst (+ 1 nmin) nmax) (pick klst 0 nmin)))
      (setq j (+ j 1))
)
(mapcar '1- klst)
)
(defun fitfun (ptlst)
  (setq numlst nil)
  (repeat (/ (length ptlst) 2)
   (setq numlst (append '(1 0) numlst))
  )
  (apply '+ (mapcar '* numlst (mapcar 'distance ptlst (append (cdr ptlst) (list (car ptlst))))))
)
;;;取点函数
(defun fp ()
(setq sn (ssget ":N" '((0 . "point"))))
(setq i 0 n (sslength sn) pts nil)
(while (< i n)
      (setq pts (cons (cons i (cdr (assoc 10 (entget (ssname sn i))))) pts))
      (setq i (+ i 1))
)
(reverse pts)
)
(setq pts (fp))
(setq poplst nil)
(repeat 100
  (setq plst (xipai (length pts)))
  (setq poplst (cons plst poplst))
)
(defun n-pt (nlst)
(mapcar '(lambda (x) (cdr (nth x pts))) nlst)
)
(setq p_best  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y))
                                    poplst
                                    poplst
                                                      )
                           '(lambda (e1 e2)  (< (car e1) (car e2)) )
                  )
            )
)
(setq p_chane 0.02  N_d 3000 ii 0)
(while (< ii N_d)
(setq vlst nil)
(foreach en poplst
   (setq nt (length en))
   (setq  ens en pc1 (nth (rnd_n nt) ens) flag t clst (list pc1))
   (while flag
         (setq r_rnd (rnd))
         (if (< r_rnd p_chane)
                        (setq pc2 (nth (rnd_n (- nt 1)) (vl-remove pc1 ens)))
            (progn
                  (setq en_rnd (nth (rnd_n nt) poplst))
                                    (if (= pc1 (last en_rnd))
                                          (setq pc2 (car en_rnd))
                                          (setq pc2 (cadr (member pc1 en_rnd)) )
                                    )
                              )
                        )
                     (if (or (= pc2 (cadr (member pc1 ens))) (= pc1 (cadr (member pc2 ens))) )
                           (setq flag nil)
               (progn
                  (if (member pc2 (member pc1 ens))
                     (setq ens (append (reverse (member pc1 (reverse ens))) (member pc2 (reverse (cdr (member pc1 ens)))) (cdr (member pc2 ens)) ))
                        (setq ens (append (reverse (member pc2 (reverse ens))) (member pc1 (reverse (cdr (member pc2 ens)))) (cdr (member pc1 ens)) ))
                  )
                  (setq pc1 pc2)
                                       (setq clst (cons pc1 clst))
                                       (if (= (length clst) (- nt 1))
                                          (setq flag nil)
                                       )
                              )
                     )
         )
   (if (< (fitfun (n-pt ens)) (fitfun (n-pt en)))
               (setq vlst (cons ens vlst))
            (setq vlst (cons en  vlst))
         )
      )
(setq ii (+ 1 ii))
(setq poplst vlst)
(setq p_bestnew  (car (vl-sort (mapcar '(lambda (x y) (cons (fitfun (n-pt x)) y)) poplst poplst)
                                          '(lambda (e1 e2)  (< (car e1) (car e2)) )
                                 )
                              )
               )
  (if (< (car p_bestnew) (car p_best) )
   (setq  p_best p_bestnew)
)
)
(setq tsp_pts (n-pt (cdr p_best)) numii 0  numjj 0)
(setq pts1 (vl-remove nil (mapcar '(lambda (x) (if (= 0 (rem (setq numii (+ numii 1)) 2)) nil x)) tsp_pts)))
(setq pts2 (vl-remove nil (mapcar '(lambda (x) (if (= 0 (rem (setq numjj (+ numjj 1)) 2)) x nil)) tsp_pts)))
(mapcar '(lambda (x y) (command "line" x y "")) pts1 pts2)
)

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

[研讨] 点集配对

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

点评

点评